made code permissive about infinities

6 files changed, 37 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index 6b2825e..62e1f3e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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