Merge 8.7. ignore MP_WUR for mp_neg() calls with equal arguments (even though MP_WUR is not enabled yet)

6 files changed, 41 insertions, 29 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ca6b9f9..ac290b6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -7922,7 +7922,7 @@ ExprAbsFunc(
 	if (mp_isneg((const mp_int *) ptr)) {
 	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
 	tooLarge:
-	    mp_neg(&big, &big);
+	    (void)mp_neg(&big, &big);
 	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
 	} else {
 	unChanged:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a2f8ad5..72b9746 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8689,7 +8689,7 @@ ExecuteExtendedUnaryMathOp(
 	}
 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 	/* ~a = - a - 1 */
-	mp_neg(&big, &big);
+	(void)mp_neg(&big, &big);
 	mp_sub_d(&big, 1, &big);
 	BIG_RESULT(&big);
     case INST_UMINUS:
@@ -8706,7 +8706,7 @@ ExecuteExtendedUnaryMathOp(
 	default:
 	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 	}
-	mp_neg(&big, &big);
+	(void)mp_neg(&big, &big);
 	BIG_RESULT(&big);
     }
 
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 1ba262b..af5ea50 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -175,7 +175,7 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
  * ROOT_CLASS respectively.
  */
 
-#define Deleted(oPtr)		((oPtr)->flags & OBJECT_DELETED)
+#define Destructing(oPtr)	((oPtr)->flags & OBJECT_DESTRUCTING)
 #define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
 #define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
 #define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
@@ -840,7 +840,7 @@ ObjectRenamedTrace(
      * 2950259].
      */
 
-    if (!Deleted(oPtr)) {
+    if (!Destructing(oPtr)) {
 	Tcl_DeleteNamespace(oPtr->namespacePtr);
     }
     oPtr->command = NULL;
@@ -880,7 +880,7 @@ TclOODeleteDescendants(
 	     * clsPtr
 	     */
 
-	    if (!Deleted(mixinSubclassPtr->thisPtr)
+	    if (!Destructing(mixinSubclassPtr->thisPtr)
 		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp,
 			mixinSubclassPtr->thisPtr->command);
@@ -900,7 +900,7 @@ TclOODeleteDescendants(
     if (clsPtr->subclasses.num > 0) {
 	while (clsPtr->subclasses.num > 0) {
 	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
-	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
+	    if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
 		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp,
 			subclassPtr->thisPtr->command);
@@ -926,7 +926,7 @@ TclOODeleteDescendants(
 	     * This condition also covers the case where instancePtr == oPtr
 	     */
 
-	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
+	    if (!Destructing(instancePtr) && !IsRoot(instancePtr) &&
 		    !(instancePtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
 	    }
@@ -968,7 +968,7 @@ TclOOReleaseClassContents(
      * Sanity check!
      */
 
-    if (!Deleted(oPtr)) {
+    if (!Destructing(oPtr)) {
 	if (IsRootClass(oPtr)) {
 	    Tcl_Panic("deleting class structure for non-deleted %s",
 		    "::oo::class");
@@ -1087,7 +1087,7 @@ TclOOReleaseClassContents(
 	ckfree(clsPtr->privateVariables.list);
     }
 
-    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
+    if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) {
 	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
     }
 }
@@ -1120,7 +1120,7 @@ ObjectNamespaceDeleted(
     Tcl_Interp *interp = oPtr->fPtr->interp;
     int i;
 
-    if (Deleted(oPtr)) {
+    if (Destructing(oPtr)) {
 	/*
 	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
 	 * this guard could be removed.
@@ -1135,7 +1135,7 @@ ObjectNamespaceDeleted(
      * records.  This is the flag that
      */
 
-    oPtr->flags |= OBJECT_DELETED;
+    oPtr->flags |= OBJECT_DESTRUCTING;
 
     /*
      * Let the dominoes fall!
@@ -1280,7 +1280,7 @@ ObjectNamespaceDeleted(
      * sometimes not go away automatically; we force it here. [Bug 2962664]
      */
 
-    if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
+    if (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr)
 	    && !Tcl_InterpDeleted(interp)) {
 	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
     }
@@ -1331,6 +1331,20 @@ TclOODecrRefCount(
 /*
  * ----------------------------------------------------------------------
  *
+ * TclOOObjectDestroyed --
+ *
+ *	Returns TCL_OK if an object is entirely deleted, i.e. the destruction
+ *	sequence has completed.
+ *
+ * ----------------------------------------------------------------------
+ */
+int TclOOObjectDestroyed(Object *oPtr) {
+    return (oPtr->namespacePtr == NULL);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOORemoveFromInstances --
  *
  *	Utility function to remove an object from the list of instances within
@@ -1473,7 +1487,7 @@ TclOOAddToSubclasses(
 				 * is assumed that the class is not already
 				 * present as a subclass in the superclass. */
 {
-    if (Deleted(superPtr->thisPtr)) {
+    if (Destructing(superPtr->thisPtr)) {
 	return;
     }
     if (superPtr->subclasses.num >= superPtr->subclasses.size) {
@@ -1538,7 +1552,7 @@ TclOOAddToMixinSubs(
 				 * is assumed that the class is not already
 				 * present as a subclass in the superclass. */
 {
-    if (Deleted(superPtr->thisPtr)) {
+    if (Destructing(superPtr->thisPtr)) {
 	return;
     }
     if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
@@ -1847,7 +1861,7 @@ FinalizeAlloc(
      * want to lose errors by accident. [Bug 2903011]
      */
 
-    if (result != TCL_ERROR && Deleted(oPtr)) {
+    if (result != TCL_ERROR && Destructing(oPtr)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"object deleted in constructor", -1));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
@@ -1862,7 +1876,7 @@ FinalizeAlloc(
 	 * command before we delete it. [Bug 9dd1bd7a74]
 	 */
 
-	if (!Deleted(oPtr)) {
+	if (!Destructing(oPtr)) {
 	    (void) TclOOObjectName(interp, oPtr);
 	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 	}
@@ -2007,7 +2021,7 @@ Tcl_CopyObjectInstance(
      */
 
     o2Ptr->flags = oPtr->flags & ~(
-	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+	    OBJECT_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
 
     /*
      * Copy the object's metadata.
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index b5b7d6c..ca984d0 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -213,14 +213,11 @@ typedef struct Object {
 				 * command. */
 } Object;
 
-#define OBJECT_DELETED	1	/* Flag to say that an object has been
-				 * destroyed. */
-#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
-				 * called. */
-#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this
-				 * object has been deleted, and so the object
-				 * should not attempt to remove itself from its
-				 * class. */
+#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
+								 *  been destroyed  */
+#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
+							   object has began */
+#define OO_UNUSED_4	4	/* No longer used.  */
 #define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
 				 * specially during teardown. */
@@ -563,6 +560,7 @@ MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
 			    const char *nameStr,
 			    const char *nsNameStr);
 MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
+MODULE_SCOPE int	TclOOObjectDestroyed(Object *oPtr);
 MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
 MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
 MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 88782dd..01b47ff 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -683,7 +683,7 @@ InvokeProcedureMethod(
      * the next thing in the chain.
      */
 
-    if (!((CallContext *)context)->oPtr->namespacePtr ||
+    if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) ||
 	Tcl_InterpDeleted(interp)
     ) {
 	return TclNRObjectContextInvokeNext(interp, context, objc, objv,
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 0ad5979..9e4e2c9 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1285,7 +1285,7 @@ TclParseNumber(
 	    }
 	    if (octalSignificandOverflow) {
 		if (signum) {
-		    mp_neg(&octalSignificandBig, &octalSignificandBig);
+		    (void)mp_neg(&octalSignificandBig, &octalSignificandBig);
 		}
 		TclSetBignumIntRep(objPtr, &octalSignificandBig);
 	    }
@@ -1318,7 +1318,7 @@ TclParseNumber(
 	    }
 	    if (significandOverflow) {
 		if (signum) {
-		    mp_neg(&significandBig, &significandBig);
+		    (void)mp_neg(&significandBig, &significandBig);
 		}
 		TclSetBignumIntRep(objPtr, &significandBig);
 	    }