summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclObj.c173
-rw-r--r--tests/obj.test68
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 <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 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:
generated by cgit v0.12 at 2024-11-05 17:05:01 (GMT)