summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c166
-rw-r--r--generic/tclEncoding.c4
-rw-r--r--generic/tclScan.c4
-rw-r--r--generic/tclStringObj.c2
4 files changed, 109 insertions, 67 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9d1e98d..cceef45 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2053,11 +2053,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) {
@@ -2070,32 +2070,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.
+ */
+
+ 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);
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
- if (!isNew) {
/*
- * 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;
@@ -2108,18 +2128,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
@@ -2167,7 +2190,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;
@@ -2228,11 +2251,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) {
@@ -2245,28 +2268,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.
@@ -2304,18 +2343,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
@@ -2335,6 +2376,7 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
+ TclInvalidateNsPath(nsPtr);
}
cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2362,7 +2404,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/generic/tclEncoding.c b/generic/tclEncoding.c
index d430b32..e328340 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2329,7 +2329,7 @@ UtfToUtfProc(
}
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
/*
- * Copy 7bit chatacters, but skip null-bytes when we are in input
+ * Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xc080.
*/
@@ -3380,7 +3380,7 @@ EscapeFromUtfProc(
/*
* The state variable has the value of oldState when word is 0.
- * In this case, the escape sequense should not be copied to dst
+ * In this case, the escape sequence should not be copied to dst
* because the current character set is not changed.
*/
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 7a6a8a2..e1fcad4 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -72,7 +72,7 @@ BuildCharSet(
CharSet *cset,
const char *format) /* Points to first char of set. */
{
- Tcl_UniChar ch, start;
+ Tcl_UniChar ch = 0, start;
int offset, nranges;
const char *end;
@@ -582,7 +582,7 @@ Tcl_ScanObjCmd(
char op = 0;
int width, underflow = 0;
Tcl_WideInt wideValue;
- Tcl_UniChar ch, sch;
+ Tcl_UniChar ch = 0, sch = 0;
Tcl_Obj **objs = NULL, *objPtr = NULL;
int flags;
char buf[513]; /* Temporary buffer to hold scanned number
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 209f982..59758bb 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1650,6 +1650,7 @@ Tcl_AppendFormatToObj(
const char *span = format, *msg, *errCode;
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
int originalLength, limit;
+ Tcl_UniChar ch = 0;
static const char *mixedXPG =
"cannot mix \"%\" and \"%n$\" conversion specifiers";
static const char *const badIndex[2] = {
@@ -1677,7 +1678,6 @@ Tcl_AppendFormatToObj(
#endif
int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
- Tcl_UniChar ch = 0;
int step = TclUtfToUniChar(format, &ch);
format += step;
generated by cgit v0.12 at 2024-11-16 22:29:42 (GMT)