Final fix for NaN != NaN bug. Thanks to Miguel Sofer for his improved patch.

[Bug 761471]

3 files changed, 63 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 66a2f7f..66d9c63 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2004-11-02  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclExecute.c (TclExecuteByteCode): NaN-equality fix from
+	Miguel Sofer. [Bug 761471]
+
 	* doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446]
 
 2004-10-31  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ef4f379..04862e4 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.9 2004/09/18 19:17:12 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.10 2004/11/02 15:46:35 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2719,26 +2719,67 @@ TclExecuteByteCode(interp, codePtr)
 	value2Ptr = stackPtr[stackTop];
 	valuePtr  = stackPtr[stackTop - 1];
 
+	/*
+	 * Be careful in the equal-object case; 'NaN' isn't supposed
+	 * to be equal to even itself. [Bug 761471]
+	 */
+
+	t1Ptr = valuePtr->typePtr;
 	if (valuePtr == value2Ptr) {
 	    /*
-	     * Optimize the equal object case.
+	     * If we are numeric already, we can proceed to the main
+	     * equality check right now.  Otherwise, we need to try to
+	     * coerce to a numeric type so we can see if we've got a
+	     * NaN but haven't parsed it as numeric.
 	     */
+	    if (!IS_NUMERIC_TYPE(t1Ptr)) {
+		if (t1Ptr == &tclListType) {
+		    int length;
+		    /*
+		     * Only a list of length 1 can be NaN or such
+		     * things.
+		     */
+		    (void) Tcl_ListObjLength(NULL, valuePtr, &length);
+		    if (length == 1) {
+			goto mustConvertForNaNCheck;
+		    }
+		} else {
+		    /*
+		     * Too bad, we'll have to compute the string and
+		     * try the conversion
+		     */
+
+		  mustConvertForNaNCheck:
+		    s1 = Tcl_GetStringFromObj(valuePtr, &length);
+		    if (TclLooksLikeInt(s1, length)) {
+			GET_WIDE_OR_INT(iResult, valuePtr, i, w);
+		    } else {
+			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+				valuePtr, &d1);
+		    }
+		    t1Ptr = valuePtr->typePtr;
+		}
+	    }
+
 	    switch (*pc) {
-	        case INST_EQ:
-	        case INST_LE:
-	        case INST_GE:
-		    iResult = 1;
-		    break;
-	        case INST_NEQ:
-	        case INST_LT:
-	        case INST_GT:
-		    iResult = 0;
-		    break;
+	    case INST_EQ:
+	    case INST_LE:
+	    case INST_GE:
+		iResult = !((t1Ptr == &tclDoubleType)
+			&& IS_NAN(valuePtr->internalRep.doubleValue));
+		break;
+	    case INST_LT:
+	    case INST_GT:
+		iResult = 0;
+		break;
+	    case INST_NEQ:
+		iResult = ((t1Ptr == &tclDoubleType)
+			&& IS_NAN(valuePtr->internalRep.doubleValue));
+		break;
 	    }
 	    goto foundResult;
 	}
 
-	t1Ptr = valuePtr->typePtr;
 	t2Ptr = value2Ptr->typePtr;
 
 	/*
diff --git a/tests/expr.test b/tests/expr.test
index 9ba169a..6ba6732 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.17.2.3 2004/09/19 15:02:36 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.17.2.4 2004/11/02 15:46:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -805,6 +805,11 @@ test expr-22.7 {non-numeric floats} nonPortable {
 test expr-22.8 {non-numeric floats} nonPortable {
     list [catch {expr {1 / Inf}} msg] $msg
 } {1 {can't use infinite floating-point value as operand of "/"}}
+# Make sure [Bug 761471] stays fixed.
+test expr-22.9 {non-numeric floats: shared object equality and NaN} {
+    set x NaN
+    expr {$x == $x}
+} 0
 
 # Some compilers get this wrong; ensure that we work around it correctly
 test expr-24.1 {expr edge cases; shifting} {expr int(5)>>31} 0