summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-11-02 15:32:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-11-02 15:32:06 (GMT)
commit5fb82ec7d47e27157b43708103e701c7a380c9d3 (patch)
tree990c793194549015c69e9f0df790ee084a05a59c /generic/tclExecute.c
parent79d364903305830d4089377396465a834754b329 (diff)
downloadtcl-5fb82ec7d47e27157b43708103e701c7a380c9d3.zip
tcl-5fb82ec7d47e27157b43708103e701c7a380c9d3.tar.gz
tcl-5fb82ec7d47e27157b43708103e701c7a380c9d3.tar.bz2
Final fix for NaN != NaN bug. Thanks to Miguel Sofer for his improved patch.
[Bug 761471]
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c72
1 files changed, 62 insertions, 10 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6d324a5..ca50a3f 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.165 2004/11/01 14:41:16 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.166 2004/11/02 15:32:06 dkf Exp $
*/
#ifdef STDC_HEADERS
@@ -1034,7 +1034,6 @@ TclExecuteByteCode(interp, codePtr)
Var *compiledLocals;
Namespace *namespacePtr;
-
/*
* Globals: variables that store state, must remain valid at
* all times.
@@ -1048,7 +1047,6 @@ TclExecuteByteCode(interp, codePtr)
* when to call Tcl_AsyncReady() */
Tcl_Obj *expandNestList = NULL;
-
/*
* Transfer variables - needed only between opcodes, but not
* while executing an instruction.
@@ -1065,7 +1063,6 @@ TclExecuteByteCode(interp, codePtr)
int result = TCL_OK; /* Return code returned after execution. */
-
/*
* Locals - variables that are used within opcodes or bounded sections
* of the file (jumps between opcodes within a family).
@@ -1343,7 +1340,7 @@ TclExecuteByteCode(interp, codePtr)
{
int opnd;
- opnd = TclGetUInt4AtPtr( pc+1 );
+ opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = *(tosPtr - opnd);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(5, 0, 1);
@@ -1485,7 +1482,7 @@ TclExecuteByteCode(interp, codePtr)
* compiler.
*/
- length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr( pc+1 );
+ length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
while ((tosPtr + length) > eePtr->endPtr) {
DECACHE_STACK_INFO();
GrowEvaluationStack(eePtr);
@@ -2350,7 +2347,6 @@ TclExecuteByteCode(interp, codePtr)
* ---------------------------------------------------------
*/
-
case INST_JUMP1:
{
int opnd;
@@ -2721,7 +2717,7 @@ TclExecuteByteCode(interp, codePtr)
int numIdx,opnd;
Tcl_Obj *valuePtr, *value2Ptr;
- opnd = TclGetUInt4AtPtr( pc + 1 );
+ opnd = TclGetUInt4AtPtr(pc + 1);
numIdx = opnd - 2;
/*
@@ -2743,7 +2739,6 @@ TclExecuteByteCode(interp, codePtr)
objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
tosPtr - numIdx, valuePtr);
-
/*
* Check for errors
*/
@@ -3242,11 +3237,67 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = *(tosPtr - 1);
/*
- * Can't optimize the equal-object case; 'NaN' isn't supposed
+ * 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) {
+ /*
+ * If we are numeric already, or a dictionary (which is
+ * never like a single-element list), 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) && (t1Ptr != &tclDictType)) {
+ 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 = !((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;
+ }
+
t2Ptr = value2Ptr->typePtr;
/*
@@ -3420,6 +3471,7 @@ TclExecuteByteCode(interp, codePtr)
* from here.
*/
+ foundResult:
pc++;
#ifndef TCL_COMPILE_DEBUG
switch (*pc) {