list/string indexes don't destroy wide int rep [Bug #526717]

3 files changed, 93 insertions, 50 deletions

diff --git a/ChangeLog b/ChangeLog
index 80c19d8..2748cf5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,13 @@
+2002-04-19  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/lindex.test (lindex-3.7): 
+	* generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from
+	hitting wide ints.  [Bug #526717]
+
 2002-04-18  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* generic/tclNamesp.c:
-	* tests/info.test:  [Bug 545325 ] info level didn't report
+	* tests/info.test: [Bug 545325] info level didn't report
 	namespace eval, bug report by Richard Suchenwirth.
 
 2002-04-18  Don Porter  <dgp@users.sourceforge.net>
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d855381..b83c7c8 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- *  RCS: @(#) $Id: tclUtil.c,v 1.30 2002/03/20 22:47:36 dgp Exp $
+ *  RCS: @(#) $Id: tclUtil.c,v 1.31 2002/04/19 13:08:56 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -67,9 +67,9 @@ TCL_DECLARE_MUTEX(precisionMutex)
  * Prototypes for procedures defined later in this file.
  */
 
-static void UpdateStringOfEndOffset _ANSI_ARGS_(( Tcl_Obj* objPtr ));
-static int SetEndOffsetFromAny _ANSI_ARGS_(( Tcl_Interp* interp,
-					     Tcl_Obj* objPtr ));
+static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
+static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
+					    Tcl_Obj* objPtr));
 
 /*
  * The following is the Tcl object type definition for an object
@@ -2179,7 +2179,7 @@ TclLooksLikeInt(bytes, length)
  *
  * Side effects:
  *	The object referenced by "objPtr" might be converted to an
- *	integer object.
+ *	integer, wide integer, or end-based-index object.
  *
  *----------------------------------------------------------------------
  */
@@ -2198,44 +2198,82 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
 {
     char *bytes;
     int length, offset;
+#ifndef TCL_WIDE_INT_IS_LONG
+    Tcl_WideInt wideOffset;
+#endif
 
-    /* If the object is already an integer, use it. */
+    /*
+     * If the object is already an integer, use it.
+     */
 
     if (objPtr->typePtr == &tclIntType) {
 	*indexPtr = (int)objPtr->internalRep.longValue;
 	return TCL_OK;
     }
 
-    if ( SetEndOffsetFromAny( NULL, objPtr ) == TCL_OK ) {
+    /*
+     * If the object is already a wide-int, and it is not out of range
+     * for an integer, use it. [Bug #526717]
+     */
+#ifndef TCL_WIDE_INT_IS_LONG
+    if (objPtr->typePtr == &tclWideIntType) {
+	Tcl_WideInt wideOffset = objPtr->internalRep.wideValue;
+	if (wideOffset >= Tcl_LongAsWide(INT_MIN)
+	    && wideOffset <= Tcl_LongAsWide(INT_MAX)) {
+	    *indexPtr = (int) Tcl_WideAsLong(wideOffset);
+	    return TCL_OK;
+	}
+    }
+#endif /* TCL_WIDE_INT_IS_LONG */
 
+    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.
+	 * If the object is already an offset from the end of the
+	 * list, or can be converted to one, use it.
 	 */
 
 	*indexPtr = endValue + objPtr->internalRep.longValue;
 
-    } else if ( Tcl_GetIntFromObj( NULL, objPtr, &offset ) == TCL_OK ) {
-
+#ifdef TCL_WIDE_INT_IS_LONG
+    } else if (Tcl_GetIntFromObj(NULL, objPtr, &offset) == TCL_OK) {
 	/*
 	 * If the object can be converted to an integer, use that.
 	 */
 
 	*indexPtr = offset;
 
-    } else {
+#else /* !TCL_WIDE_INT_IS_LONG */
+    } else if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideOffset) == TCL_OK) {
+	/*
+	 * If the object can be converted to a wide integer, use
+	 * that. [Bug #526717]
+	 */
+
+	offset = (int) Tcl_WideAsLong(wideOffset);
+	if (Tcl_LongAsWide(offset) == wideOffset) {
+	    /*
+	     * But it is representable as a narrow integer, so we
+	     * prefer that (so preserving old behaviour in the
+	     * majority of cases.)
+	     */
+	    objPtr->typePtr = &tclIntType;
+	    objPtr->internalRep.longValue = offset;
+	}
+	*indexPtr = offset;
 
+#endif /* TCL_WIDE_INT_IS_LONG */
+    } else {
 	/*
 	 * Report a parse error.
 	 */
 
 	if ((Interp *)interp != NULL) {
-	    bytes = Tcl_GetStringFromObj( objPtr, &length );
-	    Tcl_AppendStringsToObj( Tcl_GetObjResult(interp),
-				    "bad index \"", bytes,
-				    "\": must be integer or end?-integer?",
-				    (char *) NULL);
-	    if ( !strncmp ( bytes, "end-", 3 ) ) {
+	    bytes = Tcl_GetStringFromObj(objPtr, &length);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				   "bad index \"", bytes,
+				   "\": must be integer or end?-integer?",
+				   (char *) NULL);
+	    if (!strncmp(bytes, "end-", 3)) {
 		bytes += 3;
 	    }
 	    TclCheckBadOctal(interp, bytes);
@@ -2245,7 +2283,6 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
     }
 	    
     return TCL_OK;
-
 }
 
 /*
@@ -2270,21 +2307,20 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
  */
 
 static void
-UpdateStringOfEndOffset( objPtr )
+UpdateStringOfEndOffset(objPtr)
     register Tcl_Obj* objPtr;
 {
-    char buffer[ TCL_INTEGER_SPACE + sizeof("end") + 1 ];
+    char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
     register int len;
 
-    strcpy( buffer, "end" );
-    len = sizeof( "end" ) - 1;
-    if ( objPtr->internalRep.longValue != 0 ) {
+    strcpy(buffer, "end");
+    len = sizeof("end") - 1;
+    if (objPtr->internalRep.longValue != 0) {
 	buffer[len++] = '-';
-	len += TclFormatInt( buffer + len,
-			     -( objPtr->internalRep.longValue ) );
+	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
     }
-    objPtr->bytes = ckalloc( (unsigned) ( len + 1 ) );
-    strcpy( objPtr->bytes, buffer );
+    objPtr->bytes = ckalloc((unsigned) (len+1));
+    strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
 }
 
@@ -2307,10 +2343,9 @@ UpdateStringOfEndOffset( objPtr )
  */
 
 static int
-SetEndOffsetFromAny( Tcl_Interp* interp,
-				/* Tcl interpreter or NULL */
-		     Tcl_Obj* objPtr )
-				/* Pointer to the object to parse */
+SetEndOffsetFromAny(interp, objPtr)
+     Tcl_Interp* interp;	/* Tcl interpreter or NULL */
+     Tcl_Obj* objPtr;		/* Pointer to the object to parse */
 {
     int offset;			/* Offset in the "end-offset" expression */
     Tcl_ObjType* oldTypePtr = objPtr->typePtr;
@@ -2320,7 +2355,7 @@ SetEndOffsetFromAny( Tcl_Interp* interp,
 
     /* If it's already the right type, we're fine. */
 
-    if ( objPtr->typePtr == &tclEndOffsetType ) {
+    if (objPtr->typePtr == &tclEndOffsetType) {
 	return TCL_OK;
     }
 
@@ -2329,11 +2364,11 @@ SetEndOffsetFromAny( Tcl_Interp* interp,
     bytes = Tcl_GetStringFromObj(objPtr, &length);
     if ((*bytes != 'e') || (strncmp(bytes, "end",
 	    (size_t)((length > 3) ? 3 : length)) != 0)) {
-	if ( interp != NULL ) {
-	    Tcl_AppendStringsToObj( Tcl_GetObjResult( interp ),
-				    "bad index \"", bytes,
-				    "\": must be end?-integer?",
-				    (char*) NULL );
+	if (interp != NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				   "bad index \"", bytes,
+				   "\": must be end?-integer?",
+				   (char*) NULL);
 	}
 	return TCL_ERROR;
     }
@@ -2343,7 +2378,6 @@ SetEndOffsetFromAny( Tcl_Interp* interp,
     if (length <= 3) {
 	offset = 0;
     } else if (bytes[3] == '-') {
-
 	/*
 	 * This is our limited string expression evaluator
 	 */
@@ -2352,18 +2386,16 @@ SetEndOffsetFromAny( Tcl_Interp* interp,
 	}
 
     } else {
-
-	/* Conversion failed.  Report the error. */
-
-
-	if ( interp != NULL ) {
+	/*
+	 * Conversion failed.  Report the error.
+	 */
+	if (interp != NULL) {
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 				   "bad index \"", bytes,
 				   "\": must be integer or end?-integer?",
 				   (char *) NULL);
 	}
 	return TCL_ERROR;
-
     }
 
     /*
@@ -2465,7 +2497,7 @@ TclCheckBadOctal(interp, value)
 CONST char *
 Tcl_GetNameOfExecutable()
 {
-    return (tclExecutableName);
+    return tclExecutableName;
 }
 
 /*
@@ -2488,8 +2520,8 @@ Tcl_GetNameOfExecutable()
  */
 
 void
-TclpGetTime( timePtr )
+TclpGetTime(timePtr)
     Tcl_Time* timePtr;
 {
-    Tcl_GetTime( timePtr );
+    Tcl_GetTime(timePtr);
 }
diff --git a/tests/lindex.test b/tests/lindex.test
index 98ca49d..ea52e91 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: lindex.test,v 1.9 2001/11/14 23:16:35 hobbs Exp $
+# RCS: @(#) $Id: lindex.test,v 1.10 2002/04/19 13:08:56 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -83,6 +83,11 @@ test lindex-3.6 {bad octal} {
     list [catch { eval [list $lindex {a b c} $x] } result] $result
 } "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}"
 
+test lindex-3.7 {indexes don't shimmer wide ints} {
+    set x [expr {(wide(1)<<31) - 2}]
+    list $x [lindex {1 2 3} $x] [incr x] [incr x]
+} {2147483646 {} 2147483647 2147483648}
+
 # Indices relative to end
 
 test lindex-4.1 {index = end} {