diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 76 | ||||
| -rw-r--r-- | tests/expr-old.test | 17 |
3 files changed, 59 insertions, 40 deletions
@@ -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} { |