diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclObj.c | 180 | ||||
| -rw-r--r-- | tests/obj.test | 54 |
3 files changed, 212 insertions, 26 deletions
@@ -1,5 +1,9 @@ 2004-09-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * 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 c5d3c7c..1c23c8b 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.63 2004/07/07 08:21:26 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.64 2004/09/10 21:29:42 dkf Exp $ */ #include "tclInt.h" @@ -94,11 +94,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 @@ -1909,19 +1912,57 @@ 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 (result != TCL_OK) { + /* 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), @@ -1935,6 +1976,45 @@ 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(interp, objPtr) + 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". * @@ -1951,7 +2031,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. */ { @@ -1959,7 +2039,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. @@ -1976,22 +2058,17 @@ SetIntFromAny(interp, objPtr) */ errno = 0; -#ifdef TCL_STRTOUL_SIGN_CHECK for (; isspace(UCHAR(*p)) ; p++) { /* INTL: ISO space. */ /* Empty loop body. */ } if (*p == '-') { + isNegative = 1; p++; - newLong = -((long)strtoul(p, &end, 0)); } else if (*p == '+') { p++; - newLong = strtoul(p, &end, 0); - } else -#else - newLong = strtoul(p, &end, 0); -#endif - if (end == p) { - badInteger: + } + if (!isdigit(UCHAR(*p))) { + badInteger: if (interp != NULL) { Tcl_Obj *msg = Tcl_NewStringObj("expected integer but got \"", -1); @@ -2002,6 +2079,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"; @@ -2025,6 +2106,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 @@ -2035,8 +2128,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; } @@ -2268,16 +2368,46 @@ 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 c802fb0..4d7a86b 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -11,14 +11,37 @@ # 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.10 2004/06/24 10:34:12 dkf Exp $ +# RCS: @(#) $Id: obj.test,v 1.11 2004/09/10 21:29:42 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +# 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 + testConstraint testobj [llength [info commands testobj]] +testConstraint 32bit [expr {$MAX_INT == 0x7fffffff}] +testConstraint wideBiggerThanInt [expr {$MAX_WIDE > wide($MAX_INT)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 @@ -596,6 +619,35 @@ test obj-32.1 {freeing very large object trees} { unset x } {} +test obj-33.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-33.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-33.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-33.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-33.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-33.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-33.7 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 -4294967296} + if {[testConstraint testobj]} { testobj freeallvars } |