summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2021-05-20 00:52:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2021-05-20 00:52:22 (GMT)
commit584540c922511f7b03dd039bf4e7d09157878635 (patch)
tree4086b674d5b1c5a50298b8e7417f33dad258ebab /generic/tclNamesp.c
parent9cea1455ec0d8bfae73216639af0a8b78f93967c (diff)
parent9b49520dc25d320488342097655264f6ac4693cb (diff)
downloadtcl-584540c922511f7b03dd039bf4e7d09157878635.zip
tcl-584540c922511f7b03dd039bf4e7d09157878635.tar.gz
tcl-584540c922511f7b03dd039bf4e7d09157878635.tar.bz2
merge 8.7 (resolve conflicts)
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c184
1 files changed, 104 insertions, 80 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b2d717b..8f2a711 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 > (unsigned)(nsPtr == globalNsPtr)) {
@@ -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);
@@ -1073,6 +1074,84 @@ TclNamespaceDeleted(
return (nsPtr->flags & NS_DYING) ? 1 : 0;
}
+void
+TclDeleteNamespaceChildren(
+ Namespace *nsPtr /* Namespace whose children to delete */
+)
+{
+ Interp *iPtr = (Interp *) nsPtr->interp;
+ Tcl_HashEntry *entryPtr;
+ size_t i;
+ int unchecked;
+ Tcl_HashSearch search;
+ /*
+ * Delete all the child namespaces.
+ *
+ * BE CAREFUL: When each child is deleted, it divorces itself from its
+ * parent. The hash table can't be proplery traversed if its elements are
+ * being deleted. Because of traces (and the desire to avoid the
+ * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+ * f97d4ee020]) copy to a temporary array and then delete all those
+ * namespaces.
+ *
+ * Important: leave the hash table itself still live.
+ */
+
+#ifndef BREAK_NAMESPACE_COMPAT
+ unchecked = (nsPtr->childTable.numEntries > 0);
+ while (nsPtr->childTable.numEntries > 0 && unchecked) {
+ size_t length = nsPtr->childTable.numEntries;
+ Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ unchecked = 0;
+ for (i = 0 ; i < length ; i++) {
+ if (!(children[i]->flags & NS_DYING)) {
+ unchecked = 1;
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
+ }
+#else
+ if (nsPtr->childTablePtr != NULL) {
+ unchecked = (nsPtr->childTable.numEntries > 0);
+ while (nsPtr->childTable.numEntries > 0 && unchecked) {
+ size_t length = nsPtr->childTablePtr->numEntries;
+ Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ unchecked = 0;
+ for (i = 0 ; i < length ; i++) {
+ if (!(children[i]->flags & NS_DYING)) {
+ unchecked = 1;
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
+ }
+ }
+#endif
+}
+
/*
*----------------------------------------------------------------------
*
@@ -1181,62 +1260,7 @@ TclTeardownNamespace(
nsPtr->commandPathSourceList = NULL;
}
- /*
- * Delete all the child namespaces.
- *
- * BE CAREFUL: When each child is deleted, it will divorce itself from its
- * parent. You can't traverse a hash table properly if its elements are
- * being deleted. Because of traces (and the desire to avoid the
- * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
- * f97d4ee020]) we copy to a temporary array and then delete all those
- * namespaces.
- *
- * Important: leave the hash table itself still live.
- */
-
-#ifndef BREAK_NAMESPACE_COMPAT
- while (nsPtr->childTable.numEntries > 0) {
- size_t length = nsPtr->childTable.numEntries;
- Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
- sizeof(Namespace *) * length);
-
- i = 0;
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
- children[i]->refCount++;
- i++;
- }
- for (i = 0 ; i < length ; i++) {
- Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
- TclNsDecrRefCount(children[i]);
- }
- TclStackFree((Tcl_Interp *) iPtr, children);
- }
-#else
- if (nsPtr->childTablePtr != NULL) {
- while (nsPtr->childTablePtr->numEntries > 0) {
- size_t length = nsPtr->childTablePtr->numEntries;
- Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
- sizeof(Namespace *) * length);
-
- i = 0;
- for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
- entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- children[i] = Tcl_GetHashValue(entryPtr);
- children[i]->refCount++;
- i++;
- }
- for (i = 0 ; i < length ; i++) {
- Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
- TclNsDecrRefCount(children[i]);
- }
- TclStackFree((Tcl_Interp *) iPtr, children);
- }
- }
-#endif
+ TclDeleteNamespaceChildren(nsPtr);
/*
* Free the namespace's export pattern array.
@@ -2619,7 +2643,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);
@@ -2631,7 +2655,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;
@@ -2640,7 +2664,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);
@@ -2658,7 +2682,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);
@@ -3278,7 +3302,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])));