From f74fa93858b232af77de13991c43775c193df25a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 21 May 2016 09:26:07 +0000
Subject: Make the tests pass.

---
 generic/tclNamesp.c  | 40 ++++++++++++++++++++++++++--------------
 tests/namespace.test | 20 ++++++++++++++++++++
 2 files changed, 46 insertions(+), 14 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d286de4..58a86d9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1127,17 +1127,21 @@ TclTeardownNamespace(
 
     while (nsPtr->cmdTable.numEntries > 0) {
 	int length = nsPtr->cmdTable.numEntries;
-	Tcl_Command *cmds = TclStackAlloc((Tcl_Interp *) iPtr,
-		sizeof(Tcl_Command) * length);
+	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Command *) * length);
 
 	i = 0;
 	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
 		entryPtr != NULL;
 		entryPtr = Tcl_NextHashEntry(&search)) {
-	    cmds[i++] = Tcl_GetHashValue(entryPtr);
+	    cmds[i] = Tcl_GetHashValue(entryPtr);
+	    cmds[i]->refCount++;
+	    i++;
 	}
 	for (i = 0 ; i < length ; i++) {
-	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmds[i]);
+	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+		    (Tcl_Command) cmds[i]);
+	    TclCleanupCommandMacro(cmds[i]);
 	}
 	TclStackFree((Tcl_Interp *) iPtr, cmds);
     }
@@ -1188,42 +1192,50 @@ TclTeardownNamespace(
      * 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;
-	Tcl_Namespace **nss = TclStackAlloc((Tcl_Interp *) iPtr,
-		sizeof(Tcl_Namespace *) * length);
+	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Namespace *) * length);
 
 	i = 0;
 	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
 		entryPtr != NULL;
 		entryPtr = Tcl_NextHashEntry(&search)) {
-	    nss[i++] = Tcl_GetHashValue(entryPtr);
+	    children[i] = Tcl_GetHashValue(entryPtr);
+	    children[i]->refCount++;
+	    i++;
 	}
 	for (i = 0 ; i < length ; i++) {
-	    Tcl_DeleteNamespace(nss[i]);
+	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+	    TclNsDecrRefCount(children[i]);
 	}
-	TclStackFree((Tcl_Interp *) iPtr, nss);
+	TclStackFree((Tcl_Interp *) iPtr, children);
     }
 #else
     if (nsPtr->childTablePtr != NULL) {
 	while (nsPtr->childTablePtr->numEntries > 0) {
 	    int length = nsPtr->childTablePtr->numEntries;
-	    Tcl_Namespace **nss = TclStackAlloc((Tcl_Interp *) iPtr,
-		    sizeof(Tcl_Namespace *) * length);
+	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Namespace *) * length);
 
 	    i = 0;
 	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
 		    entryPtr != NULL;
 		    entryPtr = Tcl_NextHashEntry(&search)) {
-		nss[i++] = Tcl_GetHashValue(entryPtr);
+		children[i] = Tcl_GetHashValue(entryPtr);
+		children[i]->refCount++;
+		i++;
 	    }
 	    for (i = 0 ; i < length ; i++) {
-		Tcl_DeleteNamespace(nss[i]);
+		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		TclNsDecrRefCount(children[i]);
 	    }
-	    TclStackFree((Tcl_Interp *) iPtr, nss);
+	    TclStackFree((Tcl_Interp *) iPtr, children);
 	}
     }
 #endif
diff --git a/tests/namespace.test b/tests/namespace.test
index 1b31fc5..cb9bc8c 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -2972,6 +2972,26 @@ test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
     }
     namespace delete ::testing
 } {}
+test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
+    namespace eval ::testing {
+	variable gone {}
+	oo::class create CB {
+	    variable cmd
+	    constructor other {set cmd $other}
+	    destructor {rename $cmd {}; lappend ::testing::gone $cmd}
+	}
+	namespace eval abc {
+	    ::testing::CB create def ::testing::abc::ghi
+	    ::testing::CB create ghi ::testing::abc::def
+	}
+	namespace delete abc
+	try {
+	    return [lsort $gone]
+	} finally {
+	    namespace delete ::testing
+	}
+    }
+} {::testing::abc::def ::testing::abc::ghi}
 
 # cleanup
 catch {rename cmd1 {}}
-- 
cgit v0.12