diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclExecute.c | 67 | ||||
| -rw-r--r-- | tests/expr.test | 7 |
3 files changed, 63 insertions, 14 deletions
@@ -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 |