Tcl Source Code

Artifact 85daaf8047e3eeef09f98542e4836ceff3f5e54a:

Attachment "1655305.patch" to ticket [1655305fff] added by dgp 2007-02-09 01:08:01.

---

Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.124
diff -u -r1.124 tclNamesp.c
--- generic/tclNamesp.c	6 Feb 2007 23:43:49 -0000	1.124
+++ generic/tclNamesp.c	8 Feb 2007 18:06:49 -0000
@@ -505,7 +505,8 @@
 
     nsPtr = framePtr->nsPtr;
     nsPtr->activationCount--;
-    if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount == 0)) {
+    if ((nsPtr->flags & NS_DYING)
+	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
 	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
@@ -967,8 +968,7 @@
      * refCount reaches 0.
      */
 
-    if ((nsPtr->activationCount > 0)
-	    && !((nsPtr == globalNsPtr) && (nsPtr->activationCount == 1))) {
+    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
 	nsPtr->flags |= NS_DYING;
 	if (nsPtr->parentPtr != NULL) {
 	    entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.64
diff -u -r1.64 namespace.test
--- tests/namespace.test	6 Feb 2007 21:08:07 -0000	1.64
+++ tests/namespace.test	8 Feb 2007 18:06:50 -0000
@@ -148,7 +148,6 @@
 } {}
 test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
     # [Bug 1355942]
-    # Currently fails due to [Bug 1355342]
     namespace eval test_ns_2 {
         proc x {} {}
 	trace add command x delete "namespace delete [namespace current];#"
@@ -165,13 +164,26 @@
 } {}
 test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
     # [Bug 1355942]
-    # Currently fails due to [Bug 1355342]
     namespace eval test_ns_2 {
         proc x {} {}
 	trace add command x delete "namespace delete [namespace current];#"
     }
     namespace delete test_ns_2
 } {}
+test namespace-7.7 {Bug 1655305} -setup {
+    interp create slave
+    slave hide info
+    slave eval {
+	proc foo {} {
+	    namespace delete ::
+	}
+    }
+} -body {
+    slave eval foo
+    slave invokehidden info commands
+} -cleanup {
+    interp delete slave
+} -result {}
 
 
 test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
@@ -2350,7 +2362,6 @@
 }
 
 test namespace-51.13 {name resolution path control} -body {
-    # Currently fails due to [Bug 1355342]
     set ::result {}
     namespace eval ::test_ns_1 {
 	proc foo {} {lappend ::result 1}