diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclUtil.c | 128 | ||||
| -rw-r--r-- | tests/lindex.test | 7 |
3 files changed, 93 insertions, 50 deletions
@@ -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} { |