Allowed parser to recognise 'Inf' as a floating-point number. [Bug 218000]

Also produce better error messages when this happens.

4 files changed, 60 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 78b5d44..6e34532 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2002-07-22  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/expr.test (expr-22.*): Added tests to help detect the
+	corrected handling.
+	* generic/tclExecute.c (IllegalExprOperandType): Improved error
+	message generated when attempting to manipulate Inf and NaN values.
+	* generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise
+	'Inf' as a floating-point number. [Bug 218000]
+
 2002-07-21  Don Porter  <dgp@users.sourceforge.net>
 
 	* tclIOUtil.c: Silence compiler warning. [Bug 584408].
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b8d1817..c2e467e 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.80 2002/07/19 12:31:09 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.81 2002/07/22 10:04:17 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3160,7 +3160,7 @@ TclExecuteByteCode(interp, codePtr)
 	if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
 	    /*
 	     * Do double arithmetic.
-		     */
+	     */
 	    doDouble = 1;
 	    if (t1Ptr == &tclIntType) {
 		d1 = i;       /* promote value 1 to double */
@@ -4457,6 +4457,22 @@ IllegalExprOperandType(interp, pc, opndPtr)
 	int length;
 
 	s = Tcl_GetStringFromObj(opndPtr, &length);
+	/*
+	 * strtod() isn't particularly consistent about detecting Inf
+	 * and NaN between platforms.
+	 */
+	if (length == 3) {
+	    if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') &&
+		    (s[2]=='n' || s[2]=='N')) {
+		msg = "non-numeric floating-point value";
+		goto makeErrorMessage;
+	    }
+	    if ((s[0]=='i' || s[0]=='I') && (s[1]=='n' || s[1]=='N') &&
+		    (s[2]=='f' || s[2]=='F')) {
+		msg = "infinite floating-point value";
+		goto makeErrorMessage;
+	    }
+	}
 	if (TclLooksLikeInt(s, length)) {
 	    /*
 	     * If something that looks like an integer appears here, then 
@@ -4482,6 +4498,7 @@ IllegalExprOperandType(interp, pc, opndPtr)
 		msg = "floating-point value";
 	    }
 	}
+      makeErrorMessage:
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
 		msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
 		"\"", (char *) NULL);
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 6d1fc30..1c6a5f5 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.13 2002/06/21 21:17:39 jenglish Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.14 2002/07/22 10:04:17 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1628,7 +1628,8 @@ GetLexeme(infoPtr)
                 return TCL_OK;
 	    }
 	} else if (startsWithDigit || (c == '.')
-	        || (c == 'n') || (c == 'N')) {
+		|| (c == 'i') || (c == 'I')		/* Could be 'Inf' */
+	        || (c == 'n') || (c == 'N')) {		/* Could be 'NaN' */
 	    errno = 0;
 	    doubleValue = strtod(src, &termPtr);
 	    if (termPtr != src) {
diff --git a/tests/expr.test b/tests/expr.test
index 4e0f18b..90ace83 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,7 +10,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.test,v 1.15 2002/07/10 08:25:59 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.16 2002/07/22 10:04:17 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -775,6 +775,34 @@ test expr-21.10 {non-numeric boolean literals} {expr !on   } 0
 test expr-21.11 {non-numeric boolean literals} {expr !no   } 1
 test expr-21.12 {non-numeric boolean literals} {expr !yes  } 0
 
+# Test for non-numeric float handling
+test expr-22.1 {non-numeric floats} {
+    list [catch {expr {NaN + 1}} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-22.2 {non-numeric floats} {
+    list [catch {expr {Inf + 1}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "+"}}
+test expr-22.3 {non-numeric floats} {
+    set nan NaN
+    list [catch {expr {$nan + 1}} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-22.4 {non-numeric floats} {
+    set inf Inf
+    list [catch {expr {$inf + 1}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "+"}}
+test expr-22.5 {non-numeric floats} {
+    list [catch {expr NaN} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-22.6 {non-numeric floats} {
+    list [catch {expr Inf} msg] $msg
+} {1 {floating-point value too large to represent}}
+test expr-22.7 {non-numeric floats} {
+    list [catch {expr {1 / NaN}} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-22.8 {non-numeric floats} knownBug {
+    list [catch {expr {1 / Inf}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "/"}}
+
 # cleanup
 if {[info exists a]} {
     unset a