diff options
author | Kevin B Kenny <kennykb@acm.org> | 2005-03-04 20:43:41 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2005-03-04 20:43:41 (GMT) |
commit | d8a7387dda736f1c3c55fbe5adf8d3be92804523 (patch) | |
tree | 4894aa8a13760d104b0b80705c3fbae240c602da | |
parent | d4fe944beb5d77b5d4dc172ceb2475de2defa8a5 (diff) | |
download | tcl-d8a7387dda736f1c3c55fbe5adf8d3be92804523.zip tcl-d8a7387dda736f1c3c55fbe5adf8d3be92804523.tar.gz tcl-d8a7387dda736f1c3c55fbe5adf8d3be92804523.tar.bz2 |
made code permissive about infinities
-rw-r--r-- | ChangeLog | 15 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 13 | ||||
-rw-r--r-- | generic/tclExecute.c | 30 | ||||
-rw-r--r-- | generic/tclGet.c | 8 | ||||
-rw-r--r-- | generic/tclObj.c | 8 | ||||
-rw-r--r-- | generic/tclParseExpr.c | 9 |
6 files changed, 37 insertions, 46 deletions
@@ -1,3 +1,18 @@ +2005-03-04 Kevin B. Kenny <kennykb@acm.org> + + [kennykb-numerics-branch] + + * generic/tclCmdMZ.c: Changed [scan] to treat out-of-range + floating point values as infinities and zeroes. + * generic/tclExecute.c: Changed [expr] to be permissive about + infinities, allowing them to propagate. + * generic/tclGet.c: Changed Tcl_GetDouble to be permissive about + over/underflow. + * generic/tclObj.c: Changed SetDoubleFromAny to be permissive + about over/underflow. + * generic/tclParseExpr.c: Made [expr] permissive about input + numbers out of range. + 2005-03-03 Kevin B. Kenny <kennykb@acm.org> [kennykb-numerics-branch] diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 24cca7c..bdbac51 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.1 2005/02/02 15:53:17 kennykb Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.2 2005/03/04 20:43:43 kennykb Exp $ */ #include "tclInt.h" @@ -1506,16 +1506,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } errno = 0; TclStrToD(string1, (CONST char **) &stop); /* INTL: Tcl source. */ - if (errno == ERANGE) { - /* - * if (errno == ERANGE), then it was an over/underflow - * problem, but in this method, we only want to know - * yes or no, so bad flow returns 0 (false) and sets - * the failVarObj to the string length. - */ - result = 0; - failat = -1; - } else if (stop == string1) { + if (stop == string1) { /* * In this case, nothing like a number was found */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 4d90340..aaf6f8d 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.167.2.4 2005/03/02 23:30:52 kennykb Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.5 2005/03/04 20:43:44 kennykb Exp $ */ #include "tclInt.h" @@ -4011,7 +4011,7 @@ TclExecuteByteCode(interp, codePtr) * Check now for IEEE floating-point error. */ - if (IS_NAN(dResult) || IS_INF(dResult)) { + if (IS_NAN(dResult)) { TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n", O2S(valuePtr), O2S(value2Ptr))); TclExprFloatError(interp, dResult); @@ -4548,7 +4548,7 @@ TclExecuteByteCode(interp, codePtr) if (tPtr == &tclDoubleType) { d = objResultPtr->internalRep.doubleValue; - if (IS_NAN(d) || IS_INF(d)) { + if (IS_NAN(d)) { TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", O2S(objResultPtr))); TclExprFloatError(interp, d); @@ -5662,9 +5662,11 @@ ExprUnaryFunc(interp, tosPtr, clientData) errno = 0; dResult = (*func)(d); - if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) { - TclExprFloatError(interp, dResult); - return TCL_ERROR; + if ((errno != 0 ) || IS_NAN(dResult)) { + if ( errno != ERANGE || ( dResult != 0.0 && !IS_INF(dResult) )) { + TclExprFloatError(interp, dResult); + return TCL_ERROR; + } } /* @@ -5709,9 +5711,11 @@ ExprBinaryFunc(interp, tosPtr, clientData) errno = 0; dResult = (*func)(d1, d2); - if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) { - TclExprFloatError(interp, dResult); - return TCL_ERROR; + if ((errno != 0) || IS_NAN(dResult)) { + if ( errno != ERANGE || ( dResult != 0.0 && !IS_INF( dResult ) ) ) { + TclExprFloatError(interp, dResult); + return TCL_ERROR; + } } /* @@ -5786,7 +5790,7 @@ ExprAbsFunc(interp, tosPtr, clientData) } else { dResult = d; } - if (IS_NAN(dResult) || IS_INF(dResult)) { + if (IS_NAN(dResult)) { TclExprFloatError(interp, dResult); return TCL_ERROR; } @@ -5870,7 +5874,7 @@ ExprIntFunc(interp, tosPtr, clientData) goto tooLarge; } } - if (IS_NAN(d) || IS_INF(d)) { + if (IS_NAN(d)) { TclExprFloatError(interp, d); return TCL_ERROR; } @@ -5927,7 +5931,7 @@ ExprWideFunc(interp, tosPtr, clientData) goto tooLarge; } } - if (IS_NAN(d) || IS_INF(d)) { + if (IS_NAN(d)) { TclExprFloatError(interp, d); return TCL_ERROR; } @@ -6300,7 +6304,7 @@ ExprCallMathFunc(interp, objc, objv) objv[0] = Tcl_NewWideIntObj(funcResult.wideValue); } else { d = funcResult.doubleValue; - if (IS_NAN(d) || IS_INF(d)) { + if (IS_NAN(d)) { TclExprFloatError(interp, d); return TCL_ERROR; } diff --git a/generic/tclGet.c b/generic/tclGet.c index b37653f..b410ba1 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.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: tclGet.c,v 1.9.2.1 2005/02/02 15:53:24 kennykb Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.9.2.2 2005/03/04 20:43:46 kennykb Exp $ */ #include "tclInt.h" @@ -234,12 +234,6 @@ Tcl_GetDouble(interp, string, doublePtr) } return TCL_ERROR; } - if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) { - if (interp != (Tcl_Interp *) NULL) { - TclExprFloatError(interp, d); - } - return TCL_ERROR; - } while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */ end++; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 3a144b2..088a01a 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.72.2.7 2005/03/02 23:31:15 kennykb Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.72.2.8 2005/03/04 20:43:46 kennykb Exp $ */ #include "tclInt.h" @@ -1754,12 +1754,6 @@ SetDoubleFromAny(interp, objPtr) } return TCL_ERROR; } - if (errno != 0) { - if (interp != NULL) { - TclExprFloatError(interp, newDouble); - } - return TCL_ERROR; - } /* * Make sure that the string has no garbage after the end of the double. diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index 25c4c1d..a7b977f 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -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: tclParseExpr.c,v 1.23.2.4 2005/03/03 21:54:09 kennykb Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.5 2005/03/04 20:43:46 kennykb Exp $ */ #include "tclInt.h" @@ -1677,13 +1677,6 @@ GetLexeme(infoPtr) doubleValue = TclStrToD(startPtr, &termPtr); Tcl_DStringFree(&toParse); if (termPtr != startPtr) { - if (errno != 0) { - if (interp != NULL) { - TclExprFloatError(interp, doubleValue); - } - parsePtr->errorType = TCL_PARSE_BAD_NUMBER; - return TCL_ERROR; - } /* * startPtr was the start of a valid double, copied |