summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-07-03 21:36:32 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-07-03 21:36:32 (GMT)
commit6b52572402aa98c5475a5ef13429851b3306c0e3 (patch)
tree3d3362593e7cfb8ef04ca4c037c2354cdaf3861a
parenta948104085f71c7726e9e831170e90b071cf2356 (diff)
downloadtcl-6b52572402aa98c5475a5ef13429851b3306c0e3.zip
tcl-6b52572402aa98c5475a5ef13429851b3306c0e3.tar.gz
tcl-6b52572402aa98c5475a5ef13429851b3306c0e3.tar.bz2
added support for wide integers to round(); [Bug 908375], reported by
Hemang Lavana.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c76
-rw-r--r--tests/expr-old.test17
3 files changed, 58 insertions, 41 deletions
diff --git a/ChangeLog b/ChangeLog
index 3cf7bfd..6e06fb2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
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-03 Miguel Sofer <msofer@users.sf.net>
+
* generic/tclCompile.h:
* generic/tclInt.decls:
* generic/tclIntDecls.h:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3932673..46dab96 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.143 2004/06/08 19:27:01 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.144 2004/07/03 21:36:33 msofer Exp $
*/
#ifdef STDC_HEADERS
@@ -5856,9 +5856,8 @@ ExprRoundFunc(interp, tosPtr, clientData)
Tcl_Obj **tosPtr; /* Points to top of evaluation stack. */
ClientData clientData; /* Ignored. */
{
- Tcl_Obj *valuePtr;
- long iResult;
- double d, temp;
+ Tcl_Obj *valuePtr, *resPtr;
+ double d;
/*
* Pop the argument from the evaluation stack.
@@ -5870,53 +5869,50 @@ ExprRoundFunc(interp, tosPtr, clientData)
return TCL_ERROR;
}
- 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)) {
+ return TCL_OK;
+ }
+
+ d = valuePtr->internalRep.doubleValue;
+ if (d < 0.0) {
+ 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 {
- 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);
- return TCL_ERROR;
- }
- temp = (long) (d - 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 {
- if (d >= (((double) LONG_MAX + 0.5))) {
- goto tooLarge;
- }
- temp = (long) (d + 0.5);
+ resPtr = Tcl_NewLongObj((long) (d + 0.5));
}
- if (IS_NAN(temp) || IS_INF(temp)) {
- TclExprFloatError(interp, temp);
- return TCL_ERROR;
- }
- iResult = (long) temp;
}
/*
- * Push a Tcl object with the result.
+ * Free the argument Tcl_Obj and push the result object.
*/
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
+ TclDecrRefCount(valuePtr);
+ PUSH_OBJECT(resPtr);
+ return TCL_OK;
/*
- * Reflect the change to stackTop back in eePtr.
+ * Error return: result cannot be represented as an integer.
*/
-
- done:
- TclDecrRefCount(valuePtr);
- return TCL_OK;
+
+ 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);
+ return TCL_ERROR;
}
static int
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 85a408b..4025839 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.19 2004/06/23 15:36:56 dkf Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.20 2004/07/03 21:36:33 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -969,6 +969,21 @@ test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
[catch {testexprstring "1+"} msg] $msg
} {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} {