diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 8 | ||||
| -rw-r--r-- | tests/namespace.test | 19 |
3 files changed, 26 insertions, 8 deletions
@@ -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} |