[d1d05d1c7a] Fix bug parsing end-$bignum

End deprecated acceptance of "e" and "en" as index value.
Streamline and comment for clarity and improved merging to tip-445 branch.

2 files changed, 114 insertions, 121 deletions

diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 385bdd3..fa8c925 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -113,8 +113,6 @@ static int		GetEndOffsetFromObj(Tcl_Obj *objPtr,
 static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
 static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
-static int		SetEndOffsetFromAny(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
 static int		FindElement(Tcl_Interp *interp, const char *string,
 			    int stringLength, const char *typeStr,
 			    const char *typeCode, const char **elementPtr,
@@ -127,7 +125,8 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
  * stored directly in the wideValue, so no memory management is required
  * for it. This is a caching intrep, keeping the result of a parse
  * around. This type is only created from a pre-existing string, so an
- * updateStringProc will never be called and need not exist.
+ * updateStringProc will never be called and need not exist. The type
+ * is unregistered, so has no need of a setFromAnyProc either.
  */
 
 static const Tcl_ObjType endOffsetType = {
@@ -135,7 +134,7 @@ static const Tcl_ObjType endOffsetType = {
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
-    SetEndOffsetFromAny
+    NULL				/* setFromAnyProc */
 };
 
 /*
@@ -3660,10 +3659,12 @@ TclFormatInt(
  * GetWideForIndex --
  *
  *	This function produces a wide integer value corresponding to the
- *	list index held in *objPtr. The parsing supports all values
+ *	index value held in *objPtr. The parsing supports all values
  *	recognized as any size of integer, and the syntaxes end[-+]$integer
  *	and $integer[-+]$integer. The argument endValue is used to give
- *	the meaning of the literal index value "end".
+ *	the meaning of the literal index value "end". Index arithmetic
+ *	on arguments outside the wide integer range are only accepted
+ *	when interp is a working interpreter, not NULL.
  *
  * Results:
  *	When parsing of *objPtr successfully recognizes an index value,
@@ -3928,131 +3929,86 @@ GetEndOffsetFromObj(
     Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                  * representing an index. */
 {
-    if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
-        Tcl_WideInt offset = objPtr->internalRep.wideValue;
+    Tcl_WideInt offset = 0;	/* Offset in the "end-offset" expression */
 
-        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 {
-            if (endValue > LLONG_MIN - offset) {
-                *widePtr = endValue + offset;
-            } else {
-                *widePtr = LLONG_MIN;
-            }
+    if (objPtr->typePtr != &endOffsetType) {
+	int length;
+	const char *bytes = TclGetStringFromObj(objPtr, &length);
+
+	if ((length < 3) || (length == 4)) {
+	    /* Too short to be "end" or to be "end-$integer" */
+	    return TCL_ERROR;
+	}
+	if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
+	    /* Value doesn't start with "end" */
+	    return TCL_ERROR;
 	}
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
 
-/*
- *----------------------------------------------------------------------
- *
- * SetEndOffsetFromAny --
- *
- *	Look for a string of the form "end[+-]offset" and convert it to an
- *	internal representation holding the offset.
- *
- * Results:
- *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
- *
- * Side effects:
- *	If interp is not NULL, stores an error message in the interpreter
- *	result.
- *
- *----------------------------------------------------------------------
- */
+	if (length > 4) {
+	    ClientData cd;
+	    int t;
 
-static int
-SetEndOffsetFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
-    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
-{
-    Tcl_WideInt offset;			/* Offset in the "end-offset" expression */
-    register const char *bytes;	/* String rep of the object */
-    int length;			/* Length of the object's string rep */
+	    /* Parse for the "end-..." or "end+..." formats */
 
-    /*
-     * If it's already the right type, we're fine.
-     */
+	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
+		/* No operator where we need one */
+		return TCL_ERROR;
+	    }
+	    if (TclIsSpaceProc(bytes[4])) {
+		/* Space after + or - not permitted. */
+		return TCL_ERROR;
+	    }
 
-    if (objPtr->typePtr == &endOffsetType) {
-	return TCL_OK;
-    }
+	    /* Parse the integer offset */
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
+			bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
+		/* Not a recognized integer format */
+		return TCL_ERROR;
+	    }
 
-    /*
-     * Check for a string rep of the right form.
-     */
+	    /* Got an integer offset; pull it from where parser left it. */
+	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);
 
-    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);
+	    if (t == TCL_NUMBER_BIG) {
+		/* Truncate to the signed wide range. */
+		if (mp_isneg((mp_int *)cd)) {
+		    offset = (bytes[3] == '-') ? LLONG_MAX : LLONG_MIN;
+		} else {
+		    offset = (bytes[3] == '-') ? LLONG_MIN : LLONG_MAX;
+		}
+	    } else {
+		/* assert (t == TCL_NUMBER_INT); */
+		offset = (*(Tcl_WideInt *)cd);
+		if (bytes[3] == '-') {
+		    offset = (offset == LLONG_MIN) ? LLONG_MAX : -offset;
+		}
+	    }
 	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Convert the string rep.
-     */
 
-    if (length <= 3) {
-	offset = 0;
-    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
-	/*
-	 * This is our limited string expression evaluator. Pass everything
-	 * after "end-" to TclParseNumber.
-	 */
+	/* Success. Free the old internal rep and set the new one. */
+	TclFreeIntRep(objPtr);
+	objPtr->internalRep.wideValue = offset;
+	objPtr->typePtr = &endOffsetType;
+    }
 
-	if (TclIsSpaceProc(bytes[4])) {
-	    goto badIndexFormat;
-	}
-	if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL,
-		TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (objPtr->typePtr != &tclIntType) {
-		goto badIndexFormat;
-	}
-	offset = objPtr->internalRep.wideValue;
-	if (bytes[3] == '-') {
+    offset = objPtr->internalRep.wideValue;
 
-	    /* TODO: Review overflow concerns here! */
-	    offset = -offset;
-	}
+    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 {
-	/*
-	 * Conversion failed. Report the error.
-	 */
-
-    badIndexFormat:
-	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;
+        if (endValue > LLONG_MIN - offset) {
+            *widePtr = endValue + offset;
+        } else {
+            *widePtr = LLONG_MIN;
+        }
     }
-
-    /*
-     * The conversion succeeded. Free the old internal rep and set the new
-     * one.
-     */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.wideValue = offset;
-    objPtr->typePtr = &endOffsetType;
-
     return TCL_OK;
 }
 
diff --git a/tests/util.test b/tests/util.test
index 34113c0..5079a89 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -586,14 +586,14 @@ test util-9.2.1 {TclGetIntForIndex} -body {
 test util-9.2.2 {TclGetIntForIndex} -body {
     string index abcd {end }
 } -returnCodes error -match glob -result *
-test util-9.3 {TclGetIntForIndex} {
+test util-9.3 {TclGetIntForIndex} -body {
     # Deprecated
     string index abcd en
-} d
-test util-9.4 {TclGetIntForIndex} {
+} -returnCodes error -match glob -result *
+test util-9.4 {TclGetIntForIndex} -body {
     # Deprecated
     string index abcd e
-} d
+} -returnCodes error -match glob -result *
 test util-9.5.0 {TclGetIntForIndex} {
     string index abcd end-1
 } c
@@ -735,6 +735,43 @@ test util-9.45 {TclGetIntForIndex} {
 test util-9.46 {TclGetIntForIndex} {
     string index abcd end+4294967294
 } {}
+# TIP 502
+test util-9.47 {TclGetIntForIndex} {
+    string index abcd 0x10000000000000000
+} {}
+test util-9.48 {TclGetIntForIndex} {
+    string index abcd -0x10000000000000000
+} {}
+test util-9.49 {TclGetIntForIndex} -body {
+    string index abcd end*1
+} -returnCodes error -match glob -result *
+test util-9.50 {TclGetIntForIndex} -body {
+    string index abcd {end- 1}
+} -returnCodes error -match glob -result *
+test util-9.51 {TclGetIntForIndex} -body {
+    string index abcd end-end
+} -returnCodes error -match glob -result *
+test util-9.52 {TclGetIntForIndex} -body {
+    string index abcd end-x
+} -returnCodes error -match glob -result *
+test util-9.53 {TclGetIntForIndex} -body {
+    string index abcd end-0.1
+} -returnCodes error -match glob -result *
+test util-9.54 {TclGetIntForIndex} {
+    string index abcd end-0x10000000000000000
+} {}
+test util-9.55 {TclGetIntForIndex} {
+    string index abcd end+0x10000000000000000
+} {}
+test util-9.56 {TclGetIntForIndex} {
+    string index abcd end--0x10000000000000000
+} {}
+test util-9.57 {TclGetIntForIndex} {
+    string index abcd end+-0x10000000000000000
+} {}
+test util-9.58 {TclGetIntForIndex} {
+    string index abcd end--0x8000000000000000
+} {}
 
 test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
     convertDouble 0x0000000000000000