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, 58 insertions, 41 deletions
@@ -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} { |