summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
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 /generic/tclExecute.c
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.
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c76
1 files changed, 36 insertions, 40 deletions
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