summaryrefslogtreecommitdiffstats
path: root/generic
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
parent9cea1455ec0d8bfae73216639af0a8b78f93967c (diff)
parent9b49520dc25d320488342097655264f6ac4693cb (diff)
downloadtcl-584540c922511f7b03dd039bf4e7d09157878635.zip
tcl-584540c922511f7b03dd039bf4e7d09157878635.tar.gz
tcl-584540c922511f7b03dd039bf4e7d09157878635.tar.bz2
merge 8.7 (resolve conflicts)
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c5
-rw-r--r--generic/tclEnsemble.c4
-rw-r--r--generic/tclInt.h29
-rw-r--r--generic/tclLoad.c177
-rw-r--r--generic/tclNamesp.c184
-rw-r--r--generic/tclTestObj.c2
-rw-r--r--generic/tclZipfs.c3
7 files changed, 238 insertions, 166 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cafec69..e5ac9df 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3427,15 +3427,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 3c1f9ee..13408e1 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/tclInt.h b/generic/tclInt.h
index 99ef811..c03f53b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -399,29 +399,27 @@ struct NamespacePathEntry {
* Flags used to represent the status of a namespace:
*
* NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the
- * namespace but there are still active call frames on the Tcl
+ * namespace. There may still be active call frames on the Tcl
* stack that refer to the namespace. When the last call frame
- * referring to it has been popped, it's variables and command
- * will be destroyed and it will be marked "dead" (NS_DEAD). The
- * namespace can no longer be looked up by name.
+ * referring to it has been popped, its remaining variables and
+ * commands are destroyed and it is marked "dead" (NS_DEAD).
+ * NS_TEARDOWN -1 means that TclTeardownNamespace has already been called on
+ * this namespace and it should not be called again [Bug 1355942].
* NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the
- * namespace and no call frames still refer to it. Its variables
- * and command have already been destroyed. This bit allows the
- * namespace resolution code to recognize that the namespace is
- * "deleted". When the last namespaceName object in any byte code
- * unit that refers to the namespace has been freed (i.e., when
- * the namespace's refCount is 0), the namespace's storage will
- * be freed.
- * NS_KILLED - 1 means that TclTeardownNamespace has already been called on
- * this namespace and it should not be called again [Bug 1355942]
+ * namespace and no call frames still refer to it. It is no longer
+ * accessible by name. Its variables and commands have already
+ * been destroyed. When the last namespaceName object in any byte
+ * code unit that refers to the namespace has been freed (i.e.,
+ * when the namespace's refCount is 0), the namespace's storage
+ * will be freed.
* NS_SUPPRESS_COMPILATION -
* Marks the commands in this namespace for not being compiled,
* forcing them to be looked up every time.
*/
#define NS_DYING 0x01
-#define NS_DEAD 0x02
-#define NS_KILLED 0x04
+#define NS_TEARDOWN 0x02
+#define NS_DEAD 0x04
#define NS_SUPPRESS_COMPILATION 0x08
/*
@@ -2889,6 +2887,7 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
const char *name, Tcl_Namespace *nameNamespacePtr,
Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index dfe4dd0..9335437 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -12,6 +12,7 @@
#include "tclInt.h"
+
/*
* The following structure describes a library that has been loaded either
* dynamically (with the "load" command) or statically (as indicated by a call
@@ -89,8 +90,20 @@ typedef struct InterpLibrary {
* Prototypes for functions that are private to this file:
*/
-static void LoadCleanupProc(ClientData clientData,
- Tcl_Interp *interp);
+static void LoadCleanupProc(ClientData clientData,
+ Tcl_Interp *interp);
+static int IsStatic (LoadedLibrary *libraryPtr);
+static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target,
+ LoadedLibrary *library, int keepLibrary,
+ const char *fullFileName, int interpExiting);
+
+
+static int
+IsStatic (LoadedLibrary *libraryPtr) {
+ int res;
+ res = (libraryPtr->fileName[0] == '\0');
+ return res;
+}
/*
*----------------------------------------------------------------------
@@ -543,12 +556,10 @@ Tcl_UnloadObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
- LoadedLibrary *libraryPtr, *defaultPtr;
+ LoadedLibrary *libraryPtr;
Tcl_DString pfx, tmp;
- Tcl_LibraryUnloadProc *unloadProc;
InterpLibrary *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
- int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
const char *prefix;
static const char *const options[] = {
@@ -642,12 +653,11 @@ Tcl_UnloadObjCmd(
* - Its prefix and file match the once we're looking for.
* - Its file matches, and we weren't given a prefix.
* - Its prefix matches, the file name was specified as empty, and there is
- * only no statically loaded library with the same prefix.
+ * no statically loaded library with the same prefix.
*/
Tcl_MutexLock(&libraryMutex);
- defaultPtr = NULL;
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
int namesMatch, filesMatch;
@@ -671,9 +681,6 @@ Tcl_UnloadObjCmd(
if (filesMatch && (namesMatch || (prefix == NULL))) {
break;
}
- if (namesMatch && (fullFileName[0] == 0)) {
- defaultPtr = libraryPtr;
- }
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
break;
}
@@ -735,6 +742,34 @@ Tcl_UnloadObjCmd(
goto done;
}
+ code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName, 0);
+
+ done:
+ Tcl_DStringFree(&pfx);
+ Tcl_DStringFree(&tmp);
+ if (!complain && (code != TCL_OK)) {
+ code = TCL_OK;
+ Tcl_ResetResult(interp);
+ }
+ return code;
+}
+
+static int
+UnloadLibrary(
+ Tcl_Interp *interp,
+ Tcl_Interp *target,
+ LoadedLibrary *libraryPtr,
+ int keepLibrary,
+ const char *fullFileName,
+ int interpExiting
+)
+{
+ int code;
+ InterpLibrary *ipFirstPtr, *ipPtr;
+ LoadedLibrary *iterLibraryPtr;
+ int trustedRefCount = -1, safeRefCount = -1;
+ Tcl_LibraryUnloadProc *unloadProc = NULL;
+
/*
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
* libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
@@ -743,28 +778,34 @@ Tcl_UnloadObjCmd(
if (Tcl_IsSafe(target)) {
if (libraryPtr->safeUnloadProc == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "file \"%s\" cannot be unloaded under a safe interpreter",
- fullFileName));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
- NULL);
- code = TCL_ERROR;
- goto done;
+ if (!interpExiting) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a safe interpreter",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+ NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
}
unloadProc = libraryPtr->safeUnloadProc;
} else {
if (libraryPtr->unloadProc == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "file \"%s\" cannot be unloaded under a trusted interpreter",
- fullFileName));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
- NULL);
- code = TCL_ERROR;
- goto done;
+ if (!interpExiting) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a trusted interpreter",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+ NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
}
unloadProc = libraryPtr->unloadProc;
}
+
+
/*
* We are ready to unload the library. First, evaluate the unload
* function. If this fails, we cannot proceed with unload. Also, we must
@@ -775,24 +816,30 @@ Tcl_UnloadObjCmd(
* after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
*/
- code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
- if (!keepLibrary) {
- Tcl_MutexLock(&libraryMutex);
- trustedRefCount = libraryPtr->interpRefCount;
- safeRefCount = libraryPtr->safeInterpRefCount;
- Tcl_MutexUnlock(&libraryMutex);
+ if (unloadProc == NULL) {
+ code = TCL_OK;
+ } else {
+ code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
+ if (!keepLibrary) {
+ Tcl_MutexLock(&libraryMutex);
+ trustedRefCount = libraryPtr->interpRefCount;
+ safeRefCount = libraryPtr->safeInterpRefCount;
+ Tcl_MutexUnlock(&libraryMutex);
- if (Tcl_IsSafe(target)) {
- safeRefCount--;
- } else {
- trustedRefCount--;
- }
+ if (Tcl_IsSafe(target)) {
+ safeRefCount--;
+ } else {
+ trustedRefCount--;
+ }
- if (safeRefCount <= 0 && trustedRefCount <= 0) {
- code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+ if (safeRefCount <= 0 && trustedRefCount <= 0) {
+ code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+ }
}
+ code = unloadProc(target, code);
}
- code = unloadProc(target, code);
+
+
if (code != TCL_OK) {
Tcl_TransferResult(target, code, interp);
goto done;
@@ -818,16 +865,20 @@ Tcl_UnloadObjCmd(
}
}
}
- Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
- ipFirstPtr);
+ Tcl_Free(ipPtr);
+ Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr);
+ if (IsStatic(libraryPtr)) {
+ goto done;
+ }
/*
* The unload function executed fine. Examine the reference count to see
* if we unload the DLL.
*/
+
Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
libraryPtr->safeInterpRefCount--;
@@ -869,30 +920,29 @@ Tcl_UnloadObjCmd(
* it's been unloaded.
*/
- if (libraryPtr->fileName[0] != '\0') {
+ if (!IsStatic(libraryPtr)) {
Tcl_MutexLock(&libraryMutex);
if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
*/
- defaultPtr = libraryPtr;
- if (defaultPtr == firstLibraryPtr) {
+ iterLibraryPtr = libraryPtr;
+ if (iterLibraryPtr == firstLibraryPtr) {
firstLibraryPtr = libraryPtr->nextPtr;
} else {
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
libraryPtr = libraryPtr->nextPtr) {
- if (libraryPtr->nextPtr == defaultPtr) {
- libraryPtr->nextPtr = defaultPtr->nextPtr;
+ if (libraryPtr->nextPtr == iterLibraryPtr) {
+ libraryPtr->nextPtr = iterLibraryPtr->nextPtr;
break;
}
}
}
- Tcl_Free(defaultPtr->fileName);
- Tcl_Free(defaultPtr->prefix);
- Tcl_Free(defaultPtr);
- Tcl_Free(ipPtr);
+ Tcl_Free(iterLibraryPtr->fileName);
+ Tcl_Free(iterLibraryPtr->prefix);
+ Tcl_Free(iterLibraryPtr);
Tcl_MutexUnlock(&libraryMutex);
} else {
code = TCL_ERROR;
@@ -909,12 +959,6 @@ Tcl_UnloadObjCmd(
}
done:
- Tcl_DStringFree(&pfx);
- Tcl_DStringFree(&tmp);
- if (!complain && (code != TCL_OK)) {
- code = TCL_OK;
- Tcl_ResetResult(interp);
- }
return code;
}
@@ -985,6 +1029,8 @@ Tcl_StaticLibrary(
libraryPtr->loadHandle = NULL;
libraryPtr->initProc = initProc;
libraryPtr->safeInitProc = safeInitProc;
+ libraryPtr->unloadProc = NULL;
+ libraryPtr->safeUnloadProc = NULL;
Tcl_MutexLock(&libraryMutex);
libraryPtr->nextPtr = firstLibraryPtr;
firstLibraryPtr = libraryPtr;
@@ -1133,17 +1179,20 @@ TclGetLoadedLibraries(
static void
LoadCleanupProc(
- ClientData clientData, /* Pointer to first InterpLibrary structure
+ TCL_UNUSED(ClientData), /* Pointer to first InterpLibrary structure
* for interp. */
- TCL_UNUSED(Tcl_Interp *))
+ Tcl_Interp *interp)
{
- InterpLibrary *ipPtr, *nextPtr;
+ InterpLibrary *ipPtr;
+ LoadedLibrary *libraryPtr;
- ipPtr = (InterpLibrary *)clientData;
- while (ipPtr != NULL) {
- nextPtr = ipPtr->nextPtr;
- Tcl_Free(ipPtr);
- ipPtr = nextPtr;
+ while (1) {
+ ipPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
+ if (ipPtr == NULL) {
+ break;
+ }
+ libraryPtr = ipPtr->libraryPtr;
+ UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1);
}
}
@@ -1188,7 +1237,7 @@ TclFinalizeLoad(void)
* it has been unloaded.
*/
- if (libraryPtr->fileName[0] != '\0') {
+ if (!IsStatic(libraryPtr)) {
Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
}
#endif
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])));
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 47d9295..654208d 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -46,7 +46,7 @@ static Tcl_ObjCmdProc TeststringobjCmd;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
-static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp)
+static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
int i;
Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index a875263..e43c52e 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -5734,7 +5734,8 @@ ZipfsAppHookFindTclInit(
static void
ZipfsExitHandler(
- TCL_UNUSED(void *))
+ TCL_UNUSED(ClientData)
+)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;