summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c85
1 files changed, 54 insertions, 31 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7c223e9..7f75892 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1851,11 +1851,11 @@ Tcl_CreateCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
- Namespace *nsPtr, *dummy1, *dummy2;
- Command *cmdPtr, *refCmdPtr;
+ Namespace *nsPtr;
+ Command *cmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
- int isNew;
+ int isNew = 0, deleted = 0;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1868,32 +1868,52 @@ Tcl_CreateCommand(
}
/*
- * Determine where the command should reside. If its name contains
- * namespace qualifiers, we put it in the specified namespace; otherwise,
- * we always put it in the global namespace.
+ * If the command name we seek to create already exists, we need to
+ * delete that first. That can be tricky in the presence of traces.
+ * Loop until we no longer find an existing command in the way, or
+ * until we've deleted one command and that didn't finish the job.
*/
- if (strstr(cmdName, "::") != NULL) {
- TclGetNamespaceForQualName(interp, cmdName, NULL,
- TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
- if ((nsPtr == NULL) || (tail == NULL)) {
- return (Tcl_Command) NULL;
- }
- } else {
- nsPtr = iPtr->globalNsPtr;
- tail = cmdName;
- }
+ while (1) {
+ /*
+ * Determine where the command should reside. If its name contains
+ * namespace qualifiers, we put it in the specified namespace;
+ * otherwise, we always put it in the global namespace.
+ */
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
- if (!isNew) {
+ if (strstr(cmdName, "::") != NULL) {
+ Namespace *dummy1, *dummy2;
+
+ TclGetNamespaceForQualName(interp, cmdName, NULL,
+ TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+ if ((nsPtr == NULL) || (tail == NULL)) {
+ return (Tcl_Command) NULL;
+ }
+ } else {
+ nsPtr = iPtr->globalNsPtr;
+ tail = cmdName;
+ }
+
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+
+ if (isNew || deleted) {
+ /*
+ * isNew - No conflict with existing command.
+ * deleted - We've already deleted a conflicting command
+ */
+ break;
+ }
+
+ /* An existing command conflicts. Try to delete it.. */
+ cmdPtr = Tcl_GetHashValue(hPtr);
+
/*
- * Command already exists. Delete the old one. Be careful to preserve
+ * Be careful to preserve
* any existing import links so we can restore them down below. That
* way, you can redefine a command and its import status will remain
* intact.
*/
- cmdPtr = Tcl_GetHashValue(hPtr);
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
@@ -1906,18 +1926,21 @@ Tcl_CreateCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
+ deleted = 1;
+ }
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
- if (!isNew) {
- /*
- * If the deletion callback recreated the command, just throw away
- * the new command (if we try to delete it again, we could get
- * stuck in an infinite loop).
- */
+ if (!isNew) {
+ /*
+ * If the deletion callback recreated the command, just throw away
+ * the new command (if we try to delete it again, we could get
+ * stuck in an infinite loop).
+ */
+
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+
+ if (!deleted) {
- ckfree((char *) Tcl_GetHashValue(hPtr));
- }
- } else {
/*
* The list of command exported from the namespace might have changed.
* However, we do not need to recompute this just yet; next time we
@@ -1952,7 +1975,7 @@ Tcl_CreateCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
- refCmdPtr = oldRefPtr->importedCmdPtr;
+ Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;