summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2017-09-02 22:03:03 (GMT)
committerdgp <dgp@users.sourceforge.net>2017-09-02 22:03:03 (GMT)
commit4509f2480dfebe7e3e5e5f3f14833826120370fc (patch)
tree6e008b971c88635e7a4adc66bfc0e4c09cda5969
parent6832ae16ff4f18e496fe00d20334e627e2acf525 (diff)
parent1d88a1ef04b61ff723f9f102bdd25b5e6327b993 (diff)
downloadtcl-4509f2480dfebe7e3e5e5f3f14833826120370fc.zip
tcl-4509f2480dfebe7e3e5e5f3f14833826120370fc.tar.gz
tcl-4509f2480dfebe7e3e5e5f3f14833826120370fc.tar.bz2
[0e4d88b650] Allow command overwrite when deletion callback deletes namespace.
-rw-r--r--generic/tclBasic.c166
-rw-r--r--tests/basic.test15
2 files changed, 119 insertions, 62 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 14d67f6..36d2301 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2042,11 +2042,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) {
@@ -2059,32 +2059,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;
@@ -2097,18 +2117,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(Tcl_GetHashValue(hPtr));
+ }
+
+ if (!deleted) {
- ckfree(Tcl_GetHashValue(hPtr));
- }
- } else {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2156,7 +2179,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;
@@ -2217,11 +2240,11 @@ Tcl_CreateObjCommand(
{
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) {
@@ -2234,28 +2257,44 @@ Tcl_CreateObjCommand(
}
/*
- * 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,
+ 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.
+ */
+
+ 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;
- }
+ if ((nsPtr == NULL) || (tail == NULL)) {
+ return (Tcl_Command) NULL;
+ }
+ } else {
+ nsPtr = iPtr->globalNsPtr;
+ tail = cmdName;
+ }
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
- TclInvalidateNsPath(nsPtr);
- if (!isNew) {
- cmdPtr = Tcl_GetHashValue(hPtr);
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
- /* Command already exists. */
+ 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);
/*
* [***] This is wrong. See Tcl Bug a16752c252.
@@ -2293,18 +2332,20 @@ Tcl_CreateObjCommand(
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(Tcl_GetHashValue(hPtr));
- }
- } else {
+ ckfree(Tcl_GetHashValue(hPtr));
+ }
+
+ if (!deleted) {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2324,6 +2365,7 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
+ TclInvalidateNsPath(nsPtr);
}
cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2351,7 +2393,7 @@ Tcl_CreateObjCommand(
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;
diff --git a/tests/basic.test b/tests/basic.test
index 1a0037c..7ff0669 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -224,6 +224,21 @@ test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified i
list [test_ns_basic::cmd] \
[namespace delete test_ns_basic]
} {::test_ns_basic {}}
+test basic-15.2 {Tcl_CreateObjCommand, Bug 0e4d88b650} -setup {
+ proc deleter {ns args} {
+ namespace delete $ns
+ }
+ namespace eval n {
+ proc p {} {}
+ }
+ trace add command n::p delete [list [namespace which deleter] [namespace current]::n]
+} -body {
+ proc n::p {} {}
+} -cleanup {
+ namespace delete n
+ rename deleter {}
+}
+
test basic-16.1 {TclInvokeStringCommand} {emptyTest} {
} {}