summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-07-03 22:13:10 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-07-03 22:13:10 (GMT)
commit942f234d4870b465504b7a6ec70339f64a9ae69e (patch)
tree012b8d3759af2211716f2251be0f17935bb0f08b /generic/tclExecute.c
parent3b08ffe2fac031e39b7c213a45eb00e811a66b04 (diff)
downloadtcl-942f234d4870b465504b7a6ec70339f64a9ae69e.zip
tcl-942f234d4870b465504b7a6ec70339f64a9ae69e.tar.gz
tcl-942f234d4870b465504b7a6ec70339f64a9ae69e.tar.bz2
added support for wide integers to round(); [Bug 908375], reported by
Hemang Lavana.
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c76
1 files changed, 37 insertions, 39 deletions
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