From a201f0f3838bd1574ea59075e9d4db242d2e6a61 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 18 May 2021 22:09:41 +0000 Subject: Fix for issue [e39cb3f462631a99], namespace is removed from other namespace paths before deletion is complete --- generic/tclBasic.c | 5 ++--- generic/tclEnsemble.c | 4 ++-- generic/tclNamesp.c | 8 ++++---- tests/namespace.test | 28 ++++++++++++++++++---------- 4 files changed, 26 insertions(+), 19 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/tclNamesp.c b/generic/tclNamesp.c index 99a777e..64fcda4 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2640,7 +2640,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 +2652,7 @@ Tcl_FindCommand( * Next, check along the path. */ - for (i=0 ; icommandPathLength && cmdPtr==NULL ; i++) { + for (i=0 ; (cmdPtr == NULL) && icommandPathLength ; i++) { pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr; if (pathNsPtr == NULL) { continue; @@ -2661,7 +2661,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 +2679,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); diff --git a/tests/namespace.test b/tests/namespace.test index 1a18096..f826599 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,7 +207,7 @@ 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 {} @@ -2723,7 +2723,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 +2750,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 +3347,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 +3367,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 { -- cgit v0.12