From 7dbcb9eb54a05922c50c4edd15bac88410020f5c Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 1 Nov 2004 14:38:24 +0000
Subject: Fix for [Bug 761471]; NaN is now *never* equal to NaN...

---
 ChangeLog            |  3 +++
 generic/tclExecute.c | 24 +++++-------------------
 tests/expr.test      |  7 ++++++-
 3 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5638fd6..e23f2e6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2004-11-01  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclExecute.c (TclExecuteByteCode): Make INST_EQ and
+	friends handle NaN correctly in all cases. [Bug 761471]
+
 	* generic/tclNamesp.c (NamespaceInscopeCmd): Make the error
 	message generation the same as in NamespaceEvalCmd().
 	(Tcl_Import): Rationalized to use Tcl_EvalObjv().
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b5d24cd..c85f149 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.163 2004/10/28 17:21:23 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.164 2004/11/01 14:38:24 dkf Exp $
  */
 
 #ifdef STDC_HEADERS
@@ -3241,24 +3241,10 @@ TclExecuteByteCode(interp, codePtr)
 	value2Ptr = *tosPtr;
 	valuePtr  = *(tosPtr - 1);
 
-	if (valuePtr == value2Ptr) {
-	    /*
-	     * Optimize the equal object case.
-	     */
-	    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;
-	    }
-	    goto foundResult;
-	}
+	/*
+	 * Can't optimize the equal-object case; 'NaN' isn't supposed
+	 * to be equal to even itself. [Bug 761471]
+	 */
 
 	t1Ptr = valuePtr->typePtr;
 	t2Ptr = value2Ptr->typePtr;
diff --git a/tests/expr.test b/tests/expr.test
index 9e70447..9811430 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.29 2004/10/08 21:10:36 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.30 2004/11/01 14:38:26 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -809,6 +809,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
 
 # Tests for exponentiation handling
 test expr-23.1 {CompileExponentialExpr: just exponential expr} {expr 4**2} 16
-- 
cgit v0.12