diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2004-09-10 21:52:36 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2004-09-10 21:52:36 (GMT) |
commit | a69c427499edc0f882f3f6a3341f93f6310c7f1c (patch) | |
tree | e7bd5b15e987acefee05f747ac039c442fc574f9 /generic/tclObj.c | |
parent | 7a17535a4cac473a9dfab8b3816e06908e9a918f (diff) | |
download | tcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.zip tcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.tar.gz tcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.tar.bz2 |
One less crazy long/wide aunt in the attic... [Bug 868489]
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r-- | generic/tclObj.c | 173 |
1 files changed, 149 insertions, 24 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index b1183c3..60ccab4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.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: tclObj.c,v 1.42.2.5 2004/03/30 23:34:21 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.42.2.6 2004/09/10 21:52:37 dkf Exp $ */ #include "tclInt.h" @@ -60,11 +60,14 @@ static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); +static int SetIntOrWideFromAny _ANSI_ARGS_((Tcl_Interp* interp, + Tcl_Obj *objPtr)); static void UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); + #ifndef TCL_WIDE_INT_IS_LONG static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr)); #endif @@ -1747,19 +1750,54 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr) register int *intPtr; /* Place to store resulting int. */ { register long l; + Tcl_WideInt w; int result; - - if (objPtr->typePtr != &tclIntType) { - result = SetIntFromAny(interp, objPtr); + + /* + * If the object isn't already an integer of any width, try to + * convert it to one. + */ + + if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) { + result = SetIntOrWideFromAny(interp, objPtr); if (result != TCL_OK) { return result; } } - l = objPtr->internalRep.longValue; + + /* + * Object should now be either int or wide. Get its value. + */ + + if (objPtr->typePtr == &tclIntType) { + l = objPtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (objPtr->typePtr == &tclWideIntType) { + /* + * If the object is already a wide integer, don't convert it. + * This code allows for any integer in the range -ULONG_MAX to + * ULONG_MAX to be converted to a long, ignoring overflow. + * The rule preserves existing semantics for conversion of + * integers on input, but avoids inadvertent demotion of + * wide integers to 32-bit ones in the internal rep. + */ + + w = objPtr->internalRep.wideValue; + if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) { + l = Tcl_WideAsLong(w); + } else { + goto tooBig; + } +#endif + } else { + Tcl_Panic( "string->integer conversion failed to convert the obj." ); + } + if (((long)((int)l)) == l) { *intPtr = (int)objPtr->internalRep.longValue; return TCL_OK; } + tooBig: if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), @@ -1773,6 +1811,46 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr) * * SetIntFromAny -- * + * Attempts to force the internal representation for a Tcl object + * to tclIntType, specifically. + * + * Results: + * The return value is a standard object Tcl result. If an + * error occurs during conversion, an error message is left in + * the interpreter's result unless "interp" is NULL. + * + *---------------------------------------------------------------------- + */ + +static int +SetIntFromAny( Tcl_Interp* interp, + /* Tcl interpreter */ + Tcl_Obj* objPtr ) + /* Pointer to the object to convert */ +{ + int result; + + result = SetIntOrWideFromAny( interp, objPtr ); + if ( result != TCL_OK ) { + return result; + } + if ( objPtr->typePtr != &tclIntType ) { + if ( interp != NULL ) { + char *s = "integer value too large to represent"; + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); + } + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * SetIntOrWideFromAny -- + * * Attempt to generate an integer internal form for the Tcl object * "objPtr". * @@ -1789,7 +1867,7 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr) */ static int -SetIntFromAny(interp, objPtr) +SetIntOrWideFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { @@ -1797,7 +1875,9 @@ SetIntFromAny(interp, objPtr) char *string, *end; int length; register char *p; - long newLong; + unsigned long newLong; + int isNegative = 0; + int isWide = 0; /* * Get the string representation. Make it up-to-date if necessary. @@ -1814,21 +1894,16 @@ SetIntFromAny(interp, objPtr) */ errno = 0; -#ifdef TCL_STRTOUL_SIGN_CHECK for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ /* Empty loop body. */ } if (*p == '-') { p++; - newLong = -((long)strtoul(p, &end, 0)); + isNegative = 1; } else if (*p == '+') { p++; - newLong = strtoul(p, &end, 0); - } else -#else - newLong = strtoul(p, &end, 0); -#endif - if (end == p) { + } + if (!isdigit(UCHAR(*p))) { badInteger: if (interp != NULL) { /* @@ -1844,6 +1919,10 @@ SetIntFromAny(interp, objPtr) } return TCL_ERROR; } + newLong = strtoul(p, &end, 0); + if (end == p) { + goto badInteger; + } if (errno == ERANGE) { if (interp != NULL) { char *s = "integer value too large to represent"; @@ -1867,6 +1946,18 @@ SetIntFromAny(interp, objPtr) } /* + * If the resulting integer will exceed the range of a long, + * put it into a wide instead. (Tcl Bug #868489) + */ + +#ifndef TCL_WIDE_INT_IS_LONG + if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1) + || (!isNegative && newLong > LONG_MAX)) { + isWide = 1; + } +#endif + + /* * The conversion to int succeeded. Free the old internalRep before * setting the new one. We do this as late as possible to allow the * conversion code, in particular Tcl_GetStringFromObj, to use that old @@ -1877,8 +1968,15 @@ SetIntFromAny(interp, objPtr) oldTypePtr->freeIntRepProc(objPtr); } - objPtr->internalRep.longValue = newLong; - objPtr->typePtr = &tclIntType; + if (isWide) { + objPtr->internalRep.wideValue = + (isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong); + objPtr->typePtr = &tclWideIntType; + } else { + objPtr->internalRep.longValue = + (isNegative ? -(long)newLong : (long)newLong); + objPtr->typePtr = &tclIntType; + } return TCL_OK; } @@ -2110,16 +2208,43 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr) register long *longPtr; /* Place to store resulting long. */ { register int result; + Tcl_WideInt w; - if (objPtr->typePtr == &tclIntType) { - *longPtr = objPtr->internalRep.longValue; - return TCL_OK; + if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) { + result = SetIntOrWideFromAny(interp, objPtr); + if (result != TCL_OK) { + return result; + } } - result = SetIntFromAny(interp, objPtr); - if (result == TCL_OK) { - *longPtr = objPtr->internalRep.longValue; + +#ifndef TCL_WIDE_INT_IS_LONG + if (objPtr->typePtr == &tclWideIntType) { + /* + * If the object is already a wide integer, don't convert it. + * This code allows for any integer in the range -ULONG_MAX to + * ULONG_MAX to be converted to a long, ignoring overflow. + * The rule preserves existing semantics for conversion of + * integers on input, but avoids inadvertent demotion of + * wide integers to 32-bit ones in the internal rep. + */ + + w = objPtr->internalRep.wideValue; + if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) { + *longPtr = Tcl_WideAsLong(w); + return TCL_OK; + } else { + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "integer value too large to represent", -1); + } + return TCL_ERROR; + } } - return result; +#endif + + *longPtr = objPtr->internalRep.longValue; + return TCL_OK; } /* |