fix for [e39cb3f462631a99], namespace is removed from other namespace paths

before deletion is complete

5 files changed, 122 insertions, 54 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2d10812..86d7960 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3505,15 +3505,14 @@ Tcl_DeleteCommandFromToken(
     cmdPtr->flags |= CMD_DYING;
 
     /*
-     * Call trace functions for the command being deleted. Then delete its
-     * traces.
+     * Call each functions and then delete the trace.
      */
 
     cmdPtr->nsPtr->refCount++;
 
     if (cmdPtr->tracePtr != NULL) {
 	CommandTrace *tracePtr;
-	/* Note that CallCommandTraces() never frees cmdPtr, that's
+	/* CallCommandTraces() does not cmdPtr, that's
 	 * done just before Tcl_DeleteCommandFromToken() returns  */
 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 929f3ef..ccd43b9 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -165,7 +165,7 @@ TclNamespaceEnsembleCmd(
     const char *simpleName;
     int index, done;
 
-    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
+    if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
 	if (!Tcl_InterpDeleted(interp)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "tried to manipulate ensemble of deleted namespace",
@@ -1730,7 +1730,7 @@ NsEnsembleImplementationCmdNR(
 	return TCL_ERROR;
     }
 
-    if (ensemblePtr->nsPtr->flags & NS_DYING) {
+    if (ensemblePtr->nsPtr->flags & NS_DEAD) {
 	/*
 	 * Don't know how we got here, but make things give up quickly.
 	 */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d0c8173..ad9a5c1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -415,29 +415,27 @@ struct NamespacePathEntry {
  * Flags used to represent the status of a namespace:
  *
  * NS_DYING -	1 means Tcl_DeleteNamespace has been called to delete the
- *		namespace but there are still active call frames on the Tcl
+ *		namespace.  There may still be active call frames on the Tcl
  *		stack that refer to the namespace. When the last call frame
- *		referring to it has been popped, it's variables and command
- *		will be destroyed and it will be marked "dead" (NS_DEAD). The
- *		namespace can no longer be looked up by name.
+ *		referring to it has been popped, its remaining variables and
+ *		commands are destroyed and it is marked "dead" (NS_DEAD).
+ * NS_TEARDOWN  -1 means that TclTeardownNamespace has already been called on
+ *		this namespace and it should not be called again [Bug 1355942].
  * NS_DEAD -	1 means Tcl_DeleteNamespace has been called to delete the
- *		namespace and no call frames still refer to it. Its variables
- *		and command have already been destroyed. This bit allows the
- *		namespace resolution code to recognize that the namespace is
- *		"deleted". When the last namespaceName object in any byte code
- *		unit that refers to the namespace has been freed (i.e., when
- *		the namespace's refCount is 0), the namespace's storage will
- *		be freed.
- * NS_KILLED -	1 means that TclTeardownNamespace has already been called on
- *		this namespace and it should not be called again [Bug 1355942]
+ *		namespace and no call frames still refer to it. It is no longer
+ *		accessible by name. Its variables and commands have already
+ *		been destroyed.  When the last namespaceName object in any byte
+ *		code unit that refers to the namespace has been freed (i.e.,
+ *		when the namespace's refCount is 0), the namespace's storage
+ *		will be freed.
  * NS_SUPPRESS_COMPILATION -
  *		Marks the commands in this namespace for not being compiled,
  *		forcing them to be looked up every time.
  */
 
 #define NS_DYING	0x01
-#define NS_DEAD		0x02
-#define NS_KILLED	0x04
+#define NS_TEARDOWN	0x02
+#define NS_DEAD		0x04
 #define NS_SUPPRESS_COMPILATION	0x08
 
 /*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 99a777e..5dc9659 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -306,7 +306,7 @@ Tcl_PushCallFrame(
 
 	/*
 	 * TODO: Examine whether it would be better to guard based on NS_DYING
-	 * or NS_KILLED. It appears that these are not tested because they can
+	 * or NS_TEARDOWN. It appears that these are not tested because they can
 	 * be set in a global interp that has been [namespace delete]d, but
 	 * which never really completely goes away because of lingering global
 	 * things like ::errorInfo and [::unknown] and hidden commands.
@@ -986,20 +986,21 @@ 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 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 the namespace is on the call frame stack, it is marked as "dying"
+	 * (NS_DYING is OR'd into its flags):  Contents of the namespace are
+	 * still available and visible until the namespace is later marked as
+	 * NS_DEAD, and its commands and variables are still usable by any
+	 * active call frames referring to th namespace. When all active call
+	 * frames referring to the namespace have been popped from the Tcl
+	 * stack, Tcl_PopCallFrame calls Tcl_DeleteNamespace again. 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) {
@@ -1013,16 +1014,16 @@ Tcl_DeleteNamespace(
 	    }
 	}
 	nsPtr->parentPtr = NULL;
-    } else if (!(nsPtr->flags & NS_KILLED)) {
+    } else if (!(nsPtr->flags & NS_TEARDOWN)) {
 	/*
 	 * 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
+	 * interpreter is being torn down. Set the NS_TEARDOWN 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);
+	nsPtr->flags |= (NS_DYING|NS_TEARDOWN);
 
 	TclTeardownNamespace(nsPtr);
 
@@ -1060,7 +1061,7 @@ Tcl_DeleteNamespace(
 	     * get killed later, avoiding mem leaks.
 	     */
 
-	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
+	    nsPtr->flags &= ~(NS_DYING|NS_TEARDOWN);
 	}
     }
     TclNsDecrRefCount(nsPtr);
@@ -2640,7 +2641,7 @@ Tcl_FindCommand(
 		&simpleName);
 	if ((realNsPtr != NULL) && (simpleName != NULL)) {
 	    if ((cxtNsPtr == realNsPtr)
-		    || !(realNsPtr->flags & NS_DYING)) {
+		    || !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
@@ -2652,7 +2653,7 @@ Tcl_FindCommand(
 	 * Next, check along the path.
 	 */
 
-	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
+	for (i=0 ; (cmdPtr == NULL) && i<cxtNsPtr->commandPathLength ; i++) {
 	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
 	    if (pathNsPtr == NULL) {
 		continue;
@@ -2661,7 +2662,7 @@ Tcl_FindCommand(
 		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
 		    &simpleName);
 	    if ((realNsPtr != NULL) && (simpleName != NULL)
-		    && !(realNsPtr->flags & NS_DYING)) {
+		    && !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
@@ -2679,7 +2680,7 @@ Tcl_FindCommand(
 		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
 		    &simpleName);
 	    if ((realNsPtr != NULL) && (simpleName != NULL)
-		    && !(realNsPtr->flags & NS_DYING)) {
+		    && !(realNsPtr->flags & NS_DEAD)) {
 		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
 		if (entryPtr != NULL) {
 		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
@@ -3299,7 +3300,7 @@ NamespaceDeleteCmd(
 	name = TclGetString(objv[i]);
 	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
 	if ((namespacePtr == NULL)
-		|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
+		|| (((Namespace *) namespacePtr)->flags & NS_TEARDOWN)) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                     "unknown namespace \"%s\" in namespace delete command",
 		    TclGetString(objv[i])));
diff --git a/tests/namespace.test b/tests/namespace.test
index 1a18096..64f237d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -182,8 +182,8 @@ test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns}
 } {}
 test namespace-7.7 {Bug 1655305} -setup {
     interp create child
-    # Can't invoke through the ensemble, since deleting the global namespace
-    # (indirectly, via deleting ::tcl) deletes the ensemble.
+    # Can't invoke through the ensemble, since deleting ::tcl
+    # (indirectly, via deleting the global namespace) deletes the ensemble.
     child eval {rename ::tcl::info::commands ::infocommands}
     child hide infocommands
     child eval {
@@ -207,10 +207,72 @@ test namespace-7.8 {Bug ba1419303b4c} -setup {
 	namespace delete ns1
     }
 } -body {
-    # No segmentation fault given --enable-symbols=mem.
+    # No segmentation fault given --enable-symbols.
     namespace delete ns1
 } -result {}
 
+
+test namespace-7.9 {
+	Bug e39cb3f462631a99
+
+	A namespace being deleted should not be removed from other namespace paths
+	until the contents of the namespace are entirely removed.
+} -setup {
+
+
+
+
+} -body {
+
+	variable res {}
+
+
+	namespace eval ns1 {
+		proc p1 caller {
+			lappend [namespace parent]::res $caller
+		}
+	}
+
+
+	namespace eval ns1a {
+		namespace path [namespace parent]::ns1
+
+		proc t1 {old new op} {
+			$old t1
+		}
+	}
+
+	namespace eval ns2 {
+		proc p1 caller {
+			lappend [namespace parent]::res $caller
+		}
+	}
+
+	namespace eval ns2a {
+		namespace path [namespace parent]::ns2
+
+		proc t1 {old new op} {
+			[namespace tail $old] t2
+		}
+	}
+
+
+	trace add command ns1::p1 delete ns1a::t1
+	namespace delete ns1
+
+	trace add command ns2::p1 delete ns2a::t1
+	namespace delete ns2
+
+	return $res
+
+} -cleanup {
+	namespace delete ns1a
+	namespace delete ns2a
+	unset res
+} -result {t1 t2}
+
+
+
 test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
     catch {interp delete test_interp}
     interp create test_interp
@@ -2723,7 +2785,11 @@ test namespace-51.12 {name resolution path control} -body {
     catch {namespace delete ::test_ns_3}
     catch {namespace delete ::test_ns_4}
 }
-test namespace-51.13 {name resolution path control} -body {
+test namespace-51.13 {
+    name resolution path control
+    when the trace fires, ns_2 is being deleted but isn't gone yet, and is
+    still visible for the trace
+} -body {
     set ::result {}
     namespace eval ::test_ns_1 {
 	proc foo {} {lappend ::result 1}
@@ -2746,8 +2812,7 @@ test namespace-51.13 {name resolution path control} -body {
 	}
 	bar
     }
-    # Should the result be "2 {} {2 3 2 1}" instead?
-} -result {2 {} {2 3 1 1}} -cleanup {
+} -result {2 {} {2 3 2 1}} -cleanup {
     catch {namespace delete ::test_ns_1}
     catch {namespace delete ::test_ns_2}
     catch {namespace delete ::test_ns_3}
@@ -3344,11 +3409,15 @@ test namespace-56.6 {
 	Namespace deletion traces on both the original routine and the imported
 	routine should run without any memory error under a debug build.
 } -body {
-	variable res 0
+	variable res {} 
 
 	proc ondelete {old new op} {
-		$old
+	    variable res
+	    set tail [namespace tail $old] 
+	    set up [namespace tail [namespace qualifiers $old]]
+	    lappend res [list $up $tail]
 	}
+	
 
 	namespace eval ns1 {} {
 		namespace export *
@@ -3360,17 +3429,18 @@ test namespace-56.6 {
 	}
 
 	namespace eval ns2 {} {
-		namespace import ::ns1::p1
+		namespace import [namespace parent]::ns1::p1
 		trace add command p1 delete ondelete
 	}
 
 	namespace delete ns1
 	namespace delete ns2
+	after 1
 	return $res
 } -cleanup {
 	unset res
 	rename ondelete {}
-} -result 2
+} -result {{ns1 p1} {ns2 p1}}
 
 
 test namespace-57.0 {