summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c76
-rw-r--r--tests/expr-old.test17
3 files changed, 59 insertions, 40 deletions
diff --git a/ChangeLog b/ChangeLog
index e564824..56db783 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-07-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (ExprRoundFunc):
+ * tests/expr-old.test (39.1): added support for wide integers to
+ round(); [Bug 908375], reported by Hemang Lavana.
+
2004-07-02 Jeff Hobbs <jeffh@ActiveState.com>
* generic/regcomp.c (stid): correct minor pointer size error
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4f3dff4..79b03b9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.94.2.6 2004/05/25 00:08:23 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.7 2004/07/03 22:13:10 msofer Exp $
*/
#include "tclInt.h"
@@ -5328,9 +5328,8 @@ ExprRoundFunc(interp, eePtr, clientData)
{
Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
- Tcl_Obj *valuePtr;
- long iResult;
- double d, temp;
+ Tcl_Obj *valuePtr, *resPtr;
+ double d;
int result;
/*
@@ -5350,57 +5349,56 @@ ExprRoundFunc(interp, eePtr, clientData)
result = TCL_ERROR;
goto done;
}
-
- if (valuePtr->typePtr == &tclIntType) {
- iResult = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w;
- TclGetWide(w,valuePtr);
- PUSH_OBJECT(Tcl_NewWideIntObj(w));
- goto done;
+
+ if ((valuePtr->typePtr == &tclIntType) ||
+ (valuePtr->typePtr == &tclWideIntType)) {
+ result = TCL_OK;
+ resPtr = valuePtr;
} else {
d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
- if (d <= (((double) (long) LONG_MIN) - 0.5)) {
- tooLarge:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "integer value too large to represent", -1);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent",
- (char *) NULL);
- result = TCL_ERROR;
- goto done;
- }
- temp = (long) (d - 0.5);
+ if (d <= Tcl_WideAsDouble(LLONG_MIN)-0.5) {
+ goto tooLarge;
+ } else if (d <= (((double) (long) LONG_MIN) - 0.5)) {
+ resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(d - 0.5));
+ } else {
+ resPtr = Tcl_NewLongObj((long) (d - 0.5));
+ }
} else {
- if (d >= (((double) LONG_MAX + 0.5))) {
+ if (d >= Tcl_WideAsDouble(LLONG_MAX)+0.5) {
goto tooLarge;
+ } else if (d >= (((double) LONG_MAX + 0.5))) {
+ resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(d + 0.5));
+ } else {
+ resPtr = Tcl_NewLongObj((long) (d + 0.5));
}
- temp = (long) (d + 0.5);
- }
- if (IS_NAN(temp) || IS_INF(temp)) {
- TclExprFloatError(interp, temp);
- result = TCL_ERROR;
- goto done;
}
- iResult = (long) temp;
}
/*
- * Push a Tcl object with the result.
- */
-
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
-
- /*
- * Reflect the change to stackTop back in eePtr.
+ * Push the result object and free the argument Tcl_Obj.
*/
+ PUSH_OBJECT(resPtr);
+
done:
TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
+
+ /*
+ * Error return: result cannot be represented as an integer.
+ */
+
+ tooLarge:
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "integer value too large to represent", -1);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ "integer value too large to represent",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
static int
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 17d32d2..90f5cd0 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr-old.test,v 1.16.2.1 2003/03/27 13:49:22 dkf Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.16.2.2 2004/07/03 22:13:11 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -982,6 +982,21 @@ test expr-old-38.1 {Verify Tcl_ExprString's basic operation} {
} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}
}
+#
+# Test for bug #908375: rounding numbers that do not fit in a
+# long but do fit in a wide
+#
+
+test expr-old-39.1 {Rounding with wide result} {
+ set x 1.0e10
+ set y [expr $x + 0.1]
+ catch {
+ set x [list [expr {$x == round($y)}] [expr $x == -round(-$y)]]
+ }
+ set x
+} {1 1}
+unset x y
+
# Special test for Pentium arithmetic bug of 1994:
if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {