From 5f3752c577b76184a8548e74176f2fa153842de9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 8 Feb 2007 18:43:39 +0000
Subject:         * generic/tclNamesp.c:  Corrected broken logic in
 Tcl_DeleteNamespace()         * tests/namespace.test: introduced in Patch
 1577278 that caused         [namespace delete ::] to be effective only at
 level #0.  New test         namespace-7.7 should prevent similar error in the
 future. [Bug 1655305]

---
 ChangeLog            |  7 +++++++
 generic/tclNamesp.c  |  8 ++++----
 tests/namespace.test | 19 +++++++++++++++----
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 9d7277d..8af16e3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-02-08  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclNamesp.c:	Corrected broken logic in Tcl_DeleteNamespace()
+	* tests/namespace.test:	introduced in Patch 1577278 that caused
+	[namespace delete ::] to be effective only at level #0.  New test
+	namespace-7.7 should prevent similar error in the future. [Bug 1655305]
+
 2007-02-06  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclNamesp.c:	Corrected broken implementation of the
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index fb0570f..2aa4aef 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.124 2007/02/06 23:43:49 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.125 2007/02/08 18:43:40 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -505,7 +505,8 @@ Tcl_PopCallFrame(
 
     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 @@ Tcl_DeleteNamespace(
      * 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,
diff --git a/tests/namespace.test b/tests/namespace.test
index b712f01..a8e9fd5 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.64 2007/02/06 21:08:07 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.65 2007/02/08 18:43:41 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -148,7 +148,6 @@ test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
 } {}
 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.5 {recursive Tcl_DeleteNamespace, no active call frames in ns}
 } {}
 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.12 {name resolution path control} -body {
 }
 
 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}
-- 
cgit v0.12