From a69c427499edc0f882f3f6a3341f93f6310c7f1c Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 Sep 2004 21:52:36 +0000 Subject: One less crazy long/wide aunt in the attic... [Bug 868489] --- ChangeLog | 4 ++ generic/tclObj.c | 173 +++++++++++++++++++++++++++++++++++++++++++++++-------- tests/obj.test | 68 +++++++++++++++++++++- 3 files changed, 220 insertions(+), 25 deletions(-) diff --git a/ChangeLog b/ChangeLog index 63ec03d..9a7769d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2004-09-10 Donal K. Fellows + * generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value + parsing code so that values do not flip so easily between numeric + representations. Thanks to KBK for this! [Bug 868489] + * generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to set ::errorCode on error. [Bug 1025359] 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; } /* diff --git a/tests/obj.test b/tests/obj.test index c4ec7d4..7b25f91 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -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: obj.test,v 1.7 2002/04/26 08:43:38 dkf Exp $ +# RCS: @(#) $Id: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -25,6 +25,33 @@ if {[info commands testobj] == {}} { return } +# Procedure to determine the integer range of the machine + +proc int_range {} { + for { set MIN_INT 1 } { $MIN_INT > 0 } {} { + set MIN_INT [expr { $MIN_INT << 1 }] + } + set MAX_INT [expr { ~ $MIN_INT }] + return [list $MIN_INT $MAX_INT] +} + +# Procedure to determine the range of wide integers on the machine. + +proc wide_range {} { + for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} { + set MIN_WIDE [expr { $MIN_WIDE << 1 }] + } + set MAX_WIDE [expr { ~ $MIN_WIDE }] + return [list $MIN_WIDE $MAX_WIDE] +} + +foreach { MIN_INT MAX_INT } [int_range] break +foreach { MIN_WIDE MAX_WIDE } [wide_range] break +::tcltest::testConstraint 32bit \ + [expr { $MAX_INT == 0x7fffffff }] +::tcltest::testConstraint wideBiggerThanInt \ + [expr { $MAX_WIDE > wide($MAX_INT) }] + test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} { set r 1 foreach {t} { @@ -597,8 +624,47 @@ test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} { testobj invalidateStringRep 1 } end--2147483648 +test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 2147483648} + +test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 4294967295} + +test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 4294967296} + +test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483648} + +test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x8000; append x 0001 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483649} + +test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 -4294967295} + +test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 -4294967296} + testobj freeallvars # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12