6 files changed, 74 insertions, 132 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ce8c4ed..b90e12d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3662,7 +3662,7 @@ CallCommandTraces(
      */
 
     cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
-    TclCleanupCommandMacro(cmdPtr);
+    cmdPtr->refCount--;
     iPtr->activeCmdTracePtr = active.nextPtr;
     Tcl_Release(iPtr);
     return result;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d9206b3..f277a4c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2889,7 +2889,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
 			    const char *name, Tcl_Namespace *nameNamespacePtr,
 			    Tcl_Namespace *ensembleNamespacePtr, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
-MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPt);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, int dictLength,
 			    const char **elementPtr, const char **nextPtr,
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 607072b..b2d717b 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -917,10 +917,10 @@ Tcl_DeleteNamespace(
     /*
      * Give anyone interested - notably TclOO - a chance to use this namespace
      * normally despite the fact that the namespace is going to go. Allows the
-     * calling of destructors.  Only called once (unless re-established
+     * calling of destructors. Will only be called once (unless re-established
      * by the called function). [Bug 2950259]
      *
-     * Setting this field requires access to the internal definition
+     * Note that setting this field requires access to the internal definition
      * of namespaces, so it should only be accessed by code that knows about
      * being careful with reentrancy.
      */
@@ -1065,7 +1065,7 @@ Tcl_DeleteNamespace(
     }
     TclNsDecrRefCount(nsPtr);
 }
-
+
 int
 TclNamespaceDeleted(
     Namespace *nsPtr)
@@ -1073,83 +1073,6 @@ TclNamespaceDeleted(
     return (nsPtr->flags & NS_DYING) ? 1 : 0;
 }
 
-void
-TclDeleteNamespaceChildren(
-    Namespace *nsPtr	/* Namespace whose children to delete */
-)
-{
-    Interp *iPtr = (Interp *) nsPtr->interp;
-    Tcl_HashEntry *entryPtr;
-    int i, unchecked;
-    Tcl_HashSearch search;
-    /*
-     * Delete all the child namespaces.
-     *
-     * BE CAREFUL: When each child is deleted, it divorces itself from its
-     * parent.  The hash table can't be proplery traversed if its elements are
-     * being deleted.  Because of traces (and the desire to avoid the
-     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
-     * f97d4ee020]) copy to a temporary array and then delete all those
-     * namespaces.
-     *
-     * Important: leave the hash table itself still live.
-     */
-
-#ifndef BREAK_NAMESPACE_COMPAT
-    unchecked = (nsPtr->childTable.numEntries > 0);
-    while (nsPtr->childTable.numEntries > 0 && unchecked) {
-	int length = nsPtr->childTable.numEntries;
-	Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
-		sizeof(Namespace *) * length);
-
-	i = 0;
-	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
-	    children[i]->refCount++;
-	    i++;
-	}
-	unchecked = 0;
-	for (i = 0 ; i < length ; i++) {
-	    if (!(children[i]->flags & NS_DYING)) {
-		unchecked = 1;
-		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
-		TclNsDecrRefCount(children[i]);
-	    }
-	}
-	TclStackFree((Tcl_Interp *) iPtr, children);
-    }
-#else
-    if (nsPtr->childTablePtr != NULL) {
-	unchecked = (nsPtr->childTable.numEntries > 0);
-	while (nsPtr->childTable.numEntries > 0 && unchecked) {
-	    int length = nsPtr->childTablePtr->numEntries;
-	    Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
-		    sizeof(Namespace *) * length);
-
-	    i = 0;
-	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-		    entryPtr != NULL;
-		    entryPtr = Tcl_NextHashEntry(&search)) {
-		children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
-		children[i]->refCount++;
-		i++;
-	    }
-	    unchecked = 0;
-	    for (i = 0 ; i < length ; i++) {
-		if (!(children[i]->flags & NS_DYING)) {
-		    unchecked = 1;
-		    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
-		    TclNsDecrRefCount(children[i]);
-		}
-	    }
-	    TclStackFree((Tcl_Interp *) iPtr, children);
-	}
-    }
-#endif
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1182,9 +1105,6 @@ TclTeardownNamespace(
     Tcl_HashSearch search;
     size_t i;
 
-
-    TclDeleteNamespaceChildren(nsPtr);
-
     /*
      * Start by destroying the namespace's variable table, since variables
      * might trigger traces. Variable table should be cleared but not freed!
@@ -1261,6 +1181,62 @@ TclTeardownNamespace(
 	nsPtr->commandPathSourceList = NULL;
     }
 
+    /*
+     * Delete all the child namespaces.
+     *
+     * BE CAREFUL: When each child is deleted, it will divorce itself from its
+     * parent. You can't traverse a hash table properly if its elements are
+     * being deleted.  Because of traces (and the desire to avoid the
+     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+     * f97d4ee020]) we copy to a temporary array and then delete all those
+     * namespaces.
+     *
+     * Important: leave the hash table itself still live.
+     */
+
+#ifndef BREAK_NAMESPACE_COMPAT
+    while (nsPtr->childTable.numEntries > 0) {
+	size_t length = nsPtr->childTable.numEntries;
+	Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Namespace *) * length);
+
+	i = 0;
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
+	    children[i]->refCount++;
+	    i++;
+	}
+	for (i = 0 ; i < length ; i++) {
+	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+	    TclNsDecrRefCount(children[i]);
+	}
+	TclStackFree((Tcl_Interp *) iPtr, children);
+    }
+#else
+    if (nsPtr->childTablePtr != NULL) {
+	while (nsPtr->childTablePtr->numEntries > 0) {
+	    size_t length = nsPtr->childTablePtr->numEntries;
+	    Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Namespace *) * length);
+
+	    i = 0;
+	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		children[i] = Tcl_GetHashValue(entryPtr);
+		children[i]->refCount++;
+		i++;
+	    }
+	    for (i = 0 ; i < length ; i++) {
+		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		TclNsDecrRefCount(children[i]);
+	    }
+	    TclStackFree((Tcl_Interp *) iPtr, children);
+	}
+    }
+#endif
 
     /*
      * Free the namespace's export pattern array.
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 559cf0b..4dbe668 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1184,19 +1184,18 @@ ObjectNamespaceDeleted(
      * freed memory.
      */
 
-    if (oPtr->command != NULL) {
-	if (((Command *) oPtr->command)->flags && CMD_DYING) {
-	    /*
-	     * The command is already (being) deleted. Proceed to clean up the the namespace,
-	     */
-	} else {
-	    /*
-	     * The namespace must have been deleted directly.  Delete the command
-	     * as well.
-	     */
+    if (((Command *) oPtr->command)->flags && CMD_DYING) {
+	/*
+	 * Something has already started the command deletion process. We can
+	 * go ahead and clean up the the namespace,
+	 */
+    } else {
+	/*
+	 * The namespace must have been deleted directly.  Delete the command
+	 * as well.
+	 */
 
-	    Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
-	}
+	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
     }
 
     if (oPtr->myclassCommand) {
diff --git a/tests/namespace.test b/tests/namespace.test
index 679b468..3394824 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3301,8 +3301,8 @@ test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
     namespace eval ::testing {
 	namespace eval abc {proc xyz {} {}}
 	namespace eval def {proc xyz {} {}}
-	trace add command abc::xyz delete "namespace delete ::testing::def; #"
-	trace add command def::xyz delete "namespace delete ::testing::abc; #"
+	trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
+	trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
     }
     namespace delete ::testing
 } {}
diff --git a/tests/oo.test b/tests/oo.test
index 7980f9e..168baee 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1734,7 +1734,6 @@ test oo-11.6.3 {
 } -result 0 -cleanup {
 }
 
-
 test oo-11.6.4 {
     OO: cleanup ReleaseClassContents() where class is mixed into one of its
     instances
@@ -1755,34 +1754,6 @@ test oo-11.6.4 {
     rename obj1 {}
 }
 
-
-test oo-11.7 {
-    When an object is deleted its namespace is deleted, and all objects it is
-    mixed into are also deleted.  If the object has been renamed into the
-    namespace of one of the objects it has been mixed into, the routine for the
-    object might get entirely deleted before the namespace of the object is
-    entirely deleted, in which case the C routine that performs the namespace
-    deletion either must either understand that the handle on the routine for
-    the object might now be gone, or it must be guaranteed that the handle does
-    not disappear until that routine is finished.
-} -setup {
-} -body {
-    oo::class create class1
-
-    oo::object create obj1
-    oo::objdefine obj1 {
-	mixin ::class1
-    }
-    set obj1ns [info object namespace obj1]
-    set class1ns [info object namespace class1]
-    rename class1 ${obj1ns}::class1
-    # No segmentation fault
-    namespace delete $class1ns
-    return done
-} -cleanup {
-} -result done
-
-
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
     Aclass create Aobject
@@ -1806,8 +1777,6 @@ test oo-12.1 {OO: filters} {
     Aclass destroy
     return $result
 } {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
-
-
 test oo-12.2 {OO: filters} -setup {
     oo::class create Aclass
     Aclass create Aobject
@@ -4407,13 +4376,12 @@ test oo-35.6 {
 } -body {
     rename obj2 {}
     rename obj1 {}
-    # No segmentation fault
+    # doesn't crash
     return done
 } -cleanup {
     rename obj {}
 } -result done
 
-
 test oo-36.1 {TIP #470: introspection within oo::define} {
     oo::define oo::object self
 } ::oo::object