From 1c4c352fe9104950891533992dfbc449e75350aa Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 12:17:40 +0000
Subject: New test for OO cleanup:  routine for object gets deleted before
 namespace deletion is complete.

---
 tests/oo.test | 37 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 36 insertions(+), 1 deletion(-)

diff --git a/tests/oo.test b/tests/oo.test
index 168baee..404c6a4 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1734,6 +1734,7 @@ 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
@@ -1754,6 +1755,37 @@ 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 the performs the namespace
+    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::define oo::class {
+	export createWithNamespace
+    }
+    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
+} -cleanup {
+    rename obj {}
+} -result done
+
+
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
     Aclass create Aobject
@@ -1777,6 +1809,8 @@ 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
@@ -4376,12 +4410,13 @@ test oo-35.6 {
 } -body {
     rename obj2 {}
     rename obj1 {}
-    # doesn't crash
+    # No segmentation fault
     return done
 } -cleanup {
     rename obj {}
 } -result done
 
+
 test oo-36.1 {TIP #470: introspection within oo::define} {
     oo::define oo::object self
 } ::oo::object
-- 
cgit v0.12


From 756e0c234a6a4f1f304b37db96f8b3980aba66fa Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 12:33:00 +0000
Subject: OO cleanup fix that passes test 11.7.

---
 generic/tclOO.c | 23 ++++++++++++-----------
 tests/oo.test   | 13 +++++--------
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 405d5d0..452e2ef 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1184,18 +1184,19 @@ ObjectNamespaceDeleted(
      * freed memory.
      */
 
-    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.
-	 */
+    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.
+	     */
 
-	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+	    Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+	}
     }
 
     if (oPtr->myclassCommand) {
diff --git a/tests/oo.test b/tests/oo.test
index 404c6a4..7980f9e 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1761,15 +1761,12 @@ test oo-11.7 {
     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 the performs the namespace
-    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.
+    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::define oo::class {
-	export createWithNamespace
-    }
     oo::class create class1
 
     oo::object create obj1
@@ -1781,8 +1778,8 @@ test oo-11.7 {
     rename class1 ${obj1ns}::class1
     # No segmentation fault
     namespace delete $class1ns
+    return done
 } -cleanup {
-    rename obj {}
 } -result done
 
 
-- 
cgit v0.12


From c494f8045e89b1765e8faef75b2fc169b8e70e56 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 12:33:58 +0000
Subject: Use TclCleanupCommandMacro instead of just decrementing the reference
 count.

---
 generic/tclBasic.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 56356e2..e18d1b7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3740,7 +3740,7 @@ CallCommandTraces(
      */
 
     cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
-    cmdPtr->refCount--;
+    TclCleanupCommandMacro(cmdPtr);
     iPtr->activeCmdTracePtr = active.nextPtr;
     Tcl_Release(iPtr);
     return result;
-- 
cgit v0.12


From 55f8e3ac01b129121e749e40480a67bca8aa0832 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 12:36:10 +0000
Subject: Remove suspected inadvertent copypasta from test.

---
 tests/namespace.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/namespace.test b/tests/namespace.test
index efd00a8..dc0e56d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3289,8 +3289,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
 } {}
-- 
cgit v0.12


From 970479b4ee7ed81756afb201bf22fb663e9fc99a Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 12:48:54 +0000
Subject: When a namesapce is deleted delete all namespaces under it before
 making any modifictions to it.

---
 generic/tclInt.h    |   1 +
 generic/tclNamesp.c | 142 ++++++++++++++++++++++++++++++----------------------
 2 files changed, 84 insertions(+), 59 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index fa661d6..e86a0cc 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2958,6 +2958,7 @@ 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 f57b7e1..bf598d9 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. Will only be called once (unless re-established
+     * calling of destructors.  Only called once (unless re-established
      * by the called function). [Bug 2950259]
      *
-     * Note that setting this field requires access to the internal definition
+     * 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,6 +1073,83 @@ 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
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1105,6 +1182,9 @@ TclTeardownNamespace(
     Tcl_HashSearch search;
     int i;
 
+
+    TclDeleteNamespaceChildren(nsPtr);
+
     /*
      * Start by destroying the namespace's variable table, since variables
      * might trigger traces. Variable table should be cleared but not freed!
@@ -1181,62 +1261,6 @@ 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) {
-	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++;
-	}
-	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) {
-	    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] = 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.
-- 
cgit v0.12


From 42c960506de8d8e50f567cd5a0729bb61175fcd7 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 13:20:14 +0000
Subject: Changes to code comments.

---
 generic/tclNamesp.c | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index bf598d9..3ec0fb5 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -915,10 +915,11 @@ Tcl_DeleteNamespace(
     nsPtr->refCount++;
 
     /*
-     * 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
-     * by the called function). [Bug 2950259]
+     * Before marking the namespace as dying, 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 by the called function). [Bug
+     * 2950259]
      *
      * Setting this field requires access to the internal definition
      * of namespaces, so it should only be accessed by code that knows about
@@ -935,12 +936,12 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * Delete all coroutine commands now: break the circular ref cycle between
+     * Delete all coroutines now, breaking the circular ref cycle between
      * the namespace and the coroutine command [Bug 2724403]. This code is
      * essentially duplicated in TclTeardownNamespace() for all other
      * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
      *
-     * NOTE: we could avoid traversing the ns's command list by keeping a
+     * Maybe later avoid traversing the ns's command list by keeping a
      * separate list of coros.
      */
 
@@ -959,7 +960,7 @@ Tcl_DeleteNamespace(
     /*
      * If the namespace has associated ensemble commands, delete them first.
      * This leaves the actual contents of the namespace alone (unless they are
-     * linked ensemble commands, of course). Note that this code is actually
+     * linked ensemble commands, of course). This code is actually
      * reentrant so command delete traces won't purturb things badly.
      */
 
@@ -990,7 +991,7 @@ Tcl_DeleteNamespace(
      * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
      * name but its commands and variables are still usable by those active
      * call frames. When all active call frames referring to the namespace
-     * have been popped from the Tcl stack, Tcl_PopCallFrame will call this
+     * have been popped from the Tcl stack, Tcl_PopCallFrame calls this
      * function again to delete everything in the namespace. If no nsName
      * objects refer to the namespace (i.e., if its refCount is zero), its
      * commands and variables are deleted and the storage for its namespace
-- 
cgit v0.12


From 7f4cc308f37a5729cb679b8c859e8dba993095ca Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 3 Apr 2021 17:58:03 +0000
Subject: Update code comments.

---
 generic/tclNamesp.c | 57 ++++++++++++++++++++++-------------------------------
 1 file changed, 24 insertions(+), 33 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 3ec0fb5..1d20a77 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -884,22 +884,20 @@ Tcl_CreateNamespace(
  * Tcl_DeleteNamespace --
  *
  *	Deletes a namespace and all of the commands, variables, and other
- *	namespaces within it.
+ *	namespaces within it, and disassociates the namespace from its parent.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	When a namespace is deleted, it is automatically removed as a child of
- *	its parent namespace. Also, all its commands, variables and child
- *	namespaces are deleted.
+ *      See description.
  *
  *----------------------------------------------------------------------
  */
 
 void
 Tcl_DeleteNamespace(
-    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
+    Tcl_Namespace *namespacePtr)    /* Points to the namespace to delete. */
 {
     Namespace *nsPtr = (Namespace *) namespacePtr;
     Interp *iPtr = (Interp *) nsPtr->interp;
@@ -917,7 +915,7 @@ Tcl_DeleteNamespace(
     /*
      * Before marking the namespace as dying, 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
+     * the namespace is going to go.  Allows the calling of destructors.  Only
      * called once (unless re-established by the called function). [Bug
      * 2950259]
      *
@@ -936,13 +934,13 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * Delete all coroutines now, breaking the circular ref cycle between
-     * the namespace and the coroutine command [Bug 2724403]. This code is
+     * Delete all coroutines now to break the circular ref cycle between
+     * the namespace and any coroutines [Bug 2724403]. This code is
      * essentially duplicated in TclTeardownNamespace() for all other
      * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
      *
-     * Maybe later avoid traversing the ns's command list by keeping a
-     * separate list of coros.
+     * Maybe later avoid traversing the command table by keeping a
+     * separate list of coroutines.
      */
 
     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
@@ -987,20 +985,14 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * If the namespace is on the call frame stack, it is marked as "dying"
-     * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
-     * name but its commands and variables are still usable by those active
-     * call frames. When all active call frames referring to the namespace
-     * have been popped from the Tcl stack, Tcl_PopCallFrame calls this
-     * function again to delete everything in the namespace. If no nsName
-     * objects refer to the namespace (i.e., if its refCount is zero), its
-     * commands and variables are deleted and the storage for its namespace
-     * structure is freed. Otherwise, if its refCount is nonzero, the
-     * namespace's commands and variables are deleted but the structure isn't
-     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
-     * namespace resolution code to recognize that the namespace is "deleted".
-     * The structure's storage is freed by FreeNsNameInternalRep when its
-     * refCount reaches 0.
+     * If the namespace is on the call frame stack, add the flag NS_DYING,
+     * after the namesapce can not be reached by name, but its commands and
+     * variables are still usable from in those active call frames. When all
+     * active call frames referring to the namespace have been popped from the
+     * Tcl stack, Tcl_PopCallFrame calls this function again to delete
+     * everything in the namespace. Its commands and variables are deleted.
+     * When the structure's refCount reaches 0 FreeNsNameInternalRep frees the
+     * storage for the structure.
      */
 
     if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
@@ -1016,11 +1008,10 @@ Tcl_DeleteNamespace(
 	nsPtr->parentPtr = NULL;
     } else if (!(nsPtr->flags & NS_KILLED)) {
 	/*
-	 * Delete the namespace and everything in it. If this is the global
-	 * namespace, then clear it but don't free its storage unless the
-	 * interpreter is being torn down. Set the NS_KILLED flag to avoid
-	 * recursive calls here - if the namespace is really in the process of
-	 * being deleted, ignore any second call.
+	 * Time to actually delete the namespace and everything in it. If this
+	 * is the global namespace, clear it but don't free its storage unless
+	 * the interpreter is being deleted.  Set the NS_KILLED flag to prevent
+	 * additional entry to this section.
 	 */
 
 	nsPtr->flags |= (NS_DYING|NS_KILLED);
@@ -1031,8 +1022,8 @@ Tcl_DeleteNamespace(
 	    /*
 	     * If this is the global namespace, then it may have residual
 	     * "errorInfo" and "errorCode" variables for errors that occurred
-	     * while it was being torn down. Try to clear the variable list
-	     * one last time.
+	     * while it was being torn down. Try one last time to clear the
+	     * variable list.
 	     */
 
 	    TclDeleteNamespaceVars(nsPtr);
@@ -1057,8 +1048,8 @@ Tcl_DeleteNamespace(
 	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
 
 	    /*
-	     * We didn't really kill it, so remove the KILLED marks, so it can
-	     * get killed later, avoiding mem leaks.
+	     * The namespace is not deleted yet. Remove the KILLED marks, so it
+	     * can be deleted later, avoiding mem leaks.
 	     */
 
 	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
-- 
cgit v0.12


From 226bb13f4e093299c9d975ebd16c6cacb4af6356 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 4 Apr 2021 14:31:43 +0000
Subject: Fix [https://github.com/tcltk/tcl/runs/2263266926|failing test-cases]
 with --enable-symbols=mem build by reverting the series of commits that
 caused the memory-leak

---
 generic/tclBasic.c   |   2 +-
 generic/tclInt.h     |   1 -
 generic/tclNamesp.c  | 206 ++++++++++++++++++++++++---------------------------
 generic/tclOO.c      |  23 +++---
 tests/namespace.test |   4 +-
 tests/oo.test        |  34 +--------
 6 files changed, 110 insertions(+), 160 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e18d1b7..56356e2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3740,7 +3740,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 e86a0cc..fa661d6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2958,7 +2958,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 1d20a77..f57b7e1 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -884,20 +884,22 @@ Tcl_CreateNamespace(
  * Tcl_DeleteNamespace --
  *
  *	Deletes a namespace and all of the commands, variables, and other
- *	namespaces within it, and disassociates the namespace from its parent.
+ *	namespaces within it.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *      See description.
+ *	When a namespace is deleted, it is automatically removed as a child of
+ *	its parent namespace. Also, all its commands, variables and child
+ *	namespaces are deleted.
  *
  *----------------------------------------------------------------------
  */
 
 void
 Tcl_DeleteNamespace(
-    Tcl_Namespace *namespacePtr)    /* Points to the namespace to delete. */
+    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
 {
     Namespace *nsPtr = (Namespace *) namespacePtr;
     Interp *iPtr = (Interp *) nsPtr->interp;
@@ -913,13 +915,12 @@ Tcl_DeleteNamespace(
     nsPtr->refCount++;
 
     /*
-     * Before marking the namespace as dying, 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 by the called function). [Bug
-     * 2950259]
+     * 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. 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.
      */
@@ -934,13 +935,13 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * Delete all coroutines now to break the circular ref cycle between
-     * the namespace and any coroutines [Bug 2724403]. This code is
+     * Delete all coroutine commands now: break the circular ref cycle between
+     * the namespace and the coroutine command [Bug 2724403]. This code is
      * essentially duplicated in TclTeardownNamespace() for all other
      * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
      *
-     * Maybe later avoid traversing the command table by keeping a
-     * separate list of coroutines.
+     * NOTE: we could avoid traversing the ns's command list by keeping a
+     * separate list of coros.
      */
 
     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
@@ -958,7 +959,7 @@ Tcl_DeleteNamespace(
     /*
      * If the namespace has associated ensemble commands, delete them first.
      * This leaves the actual contents of the namespace alone (unless they are
-     * linked ensemble commands, of course). This code is actually
+     * linked ensemble commands, of course). Note that this code is actually
      * reentrant so command delete traces won't purturb things badly.
      */
 
@@ -985,14 +986,20 @@ Tcl_DeleteNamespace(
     }
 
     /*
-     * If the namespace is on the call frame stack, add the flag NS_DYING,
-     * after the namesapce can not be reached by name, but its commands and
-     * variables are still usable from in those active call frames. When all
-     * active call frames referring to the namespace have been popped from the
-     * Tcl stack, Tcl_PopCallFrame calls this function again to delete
-     * everything in the namespace. Its commands and variables are deleted.
-     * When the structure's refCount reaches 0 FreeNsNameInternalRep frees the
-     * storage for the structure.
+     * If the namespace is on the call frame stack, it is marked as "dying"
+     * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
+     * name but its commands and variables are still usable by those active
+     * call frames. When all active call frames referring to the namespace
+     * have been popped from the Tcl stack, Tcl_PopCallFrame will call this
+     * function again to delete everything in the namespace. If no nsName
+     * objects refer to the namespace (i.e., if its refCount is zero), its
+     * commands and variables are deleted and the storage for its namespace
+     * structure is freed. Otherwise, if its refCount is nonzero, the
+     * namespace's commands and variables are deleted but the structure isn't
+     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
+     * namespace resolution code to recognize that the namespace is "deleted".
+     * The structure's storage is freed by FreeNsNameInternalRep when its
+     * refCount reaches 0.
      */
 
     if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
@@ -1008,10 +1015,11 @@ Tcl_DeleteNamespace(
 	nsPtr->parentPtr = NULL;
     } else if (!(nsPtr->flags & NS_KILLED)) {
 	/*
-	 * Time to actually delete the namespace and everything in it. If this
-	 * is the global namespace, clear it but don't free its storage unless
-	 * the interpreter is being deleted.  Set the NS_KILLED flag to prevent
-	 * additional entry to this section.
+	 * Delete the namespace and everything in it. If this is the global
+	 * namespace, then clear it but don't free its storage unless the
+	 * interpreter is being torn down. Set the NS_KILLED flag to avoid
+	 * recursive calls here - if the namespace is really in the process of
+	 * being deleted, ignore any second call.
 	 */
 
 	nsPtr->flags |= (NS_DYING|NS_KILLED);
@@ -1022,8 +1030,8 @@ Tcl_DeleteNamespace(
 	    /*
 	     * If this is the global namespace, then it may have residual
 	     * "errorInfo" and "errorCode" variables for errors that occurred
-	     * while it was being torn down. Try one last time to clear the
-	     * variable list.
+	     * while it was being torn down. Try to clear the variable list
+	     * one last time.
 	     */
 
 	    TclDeleteNamespaceVars(nsPtr);
@@ -1048,8 +1056,8 @@ Tcl_DeleteNamespace(
 	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
 
 	    /*
-	     * The namespace is not deleted yet. Remove the KILLED marks, so it
-	     * can be deleted later, avoiding mem leaks.
+	     * We didn't really kill it, so remove the KILLED marks, so it can
+	     * get killed later, avoiding mem leaks.
 	     */
 
 	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
@@ -1057,7 +1065,7 @@ Tcl_DeleteNamespace(
     }
     TclNsDecrRefCount(nsPtr);
 }
-
+
 int
 TclNamespaceDeleted(
     Namespace *nsPtr)
@@ -1065,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
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1174,9 +1105,6 @@ TclTeardownNamespace(
     Tcl_HashSearch search;
     int i;
 
-
-    TclDeleteNamespaceChildren(nsPtr);
-
     /*
      * Start by destroying the namespace's variable table, since variables
      * might trigger traces. Variable table should be cleared but not freed!
@@ -1253,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) {
+	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++;
+	}
+	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) {
+	    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] = 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 452e2ef..405d5d0 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 dc0e56d..efd00a8 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3289,8 +3289,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
-- 
cgit v0.12