summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c20
-rw-r--r--generic/tclCompile.c2
-rw-r--r--generic/tclEnsemble.c8
-rw-r--r--generic/tclExecute.c20
-rw-r--r--generic/tclInt.h38
-rw-r--r--generic/tclNamesp.c34
-rw-r--r--generic/tclOO.c2
-rw-r--r--generic/tclObj.c2
8 files changed, 78 insertions, 48 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4cc579b..75f8527 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2785,6 +2785,8 @@ TclCreateObjCommandInNs(
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+ cmdPtr->refCount++;
+ TclCleanupCommandMacro(dataPtr->realCmdPtr);
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -3374,7 +3376,7 @@ Tcl_GetCommandFullName(
* separator, and the command name.
*/
- if (cmdPtr != NULL) {
+ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) {
if (cmdPtr->nsPtr != NULL) {
Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
@@ -3464,7 +3466,7 @@ Tcl_DeleteCommandFromToken(
* and skip nested deletes.
*/
- if (cmdPtr->flags & CMD_IS_DELETED) {
+ if (cmdPtr->flags & CMD_DYING) {
/*
* Another deletion is already in progress. Remove the hash table
* entry now, but don't invoke a callback or free the command
@@ -3496,7 +3498,7 @@ Tcl_DeleteCommandFromToken(
* be ignored.
*/
- cmdPtr->flags |= CMD_IS_DELETED;
+ cmdPtr->flags |= CMD_DYING;
/*
* Call trace functions for the command being deleted. Then delete its
@@ -3526,7 +3528,7 @@ Tcl_DeleteCommandFromToken(
}
/*
- * The list of command exported from the namespace might have changed.
+ * The list of commands exported from the namespace might have changed.
* However, we do not need to recompute this just yet; next time we need
* the info will be soon enough.
*/
@@ -3661,7 +3663,7 @@ CallCommandTraces(
* While a rename trace is active, we will not process any more rename
* traces; while a delete trace is active we will never reach here -
* because Tcl_DeleteCommandFromToken checks for the condition
- * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
+ * (cmdPtr->flags & CMD_DYING) and returns immediately when a
* command deletion is in progress. For all other traces, delete
* traces will not be invoked but a call to TraceCommandProc will
* ensure that tracePtr->clientData is freed whenever the command
@@ -5214,7 +5216,7 @@ TEOV_RunLeaveTraces(
int length;
const char *command = TclGetStringFromObj(commandPtr, &length);
- if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+ if (!(cmdPtr->flags & CMD_DYING)) {
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -6460,7 +6462,7 @@ TclNREvalObjEx(
/*
* Shimmer protection! Always pass an unshared obj. The caller could
* incr the refCount of objPtr AFTER calling us! To be completely safe
- * we always make a copy. The callback takes care od the refCounts for
+ * we always make a copy. The callback takes care of the refCounts for
* both listPtr and objPtr.
*
* TODO: Create a test to demo this need, or eliminate it.
@@ -9513,7 +9515,7 @@ NRCoroutineCallerCallback(
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
- if (cmdPtr->flags & CMD_IS_DELETED) {
+ if (cmdPtr->flags & CMD_DYING) {
/*
* The command was deleted while it was running: wind down the
* execEnv, this will do the complete cleanup. RewindCoroutine will
@@ -10282,7 +10284,7 @@ TclInfoCoroutineCmd(
return TCL_ERROR;
}
- if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
Tcl_Obj *namePtr;
TclNewObj(namePtr);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index fd63da3..7d67e12 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1834,7 +1834,7 @@ CompileCmdLiteral(
bytes = TclGetStringFromObj(cmdObj, &numBytes);
cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
- if (cmdPtr) {
+ if (cmdPtr && TclRoutineHasName(cmdPtr)) {
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
}
TclEmitPush(cmdLitIdx, envPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 3c99631..16bf8f7 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3161,7 +3161,7 @@ TclCompileEnsemble(
}
/*
- * Now we've done the mapping process, can now actually try to compile.
+ * Now that the mapping process is done we actually try to compile.
* If there is a subcommand compiler and that successfully produces code,
* we'll use that. Otherwise, we fall back to generating opcodes to do the
* invoke at runtime.
@@ -3261,9 +3261,9 @@ TclAttemptCompileProc(
/*
* Advance parsePtr->tokenPtr so that it points at the last subcommand.
- * This will be wrong, but it will not matter, and it will put the
- * tokens for the arguments in the right place without the needed to
- * allocate a synthetic Tcl_Parse struct, or copy tokens around.
+ * This will be wrong but it will not matter, and it will put the
+ * tokens for the arguments in the right place without the need to
+ * allocate a synthetic Tcl_Parse struct or copy tokens around.
*/
for (i = 0; i < depth - 1; i++) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0f1c2cc..786fffb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4464,7 +4464,7 @@ TEBCresume(
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
TclNewObj(objResultPtr);
- if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
objResultPtr);
}
@@ -4524,6 +4524,18 @@ TEBCresume(
TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
if (cmd == NULL) {
+ goto instOriginError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+
+ TclNewObj(objResultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+ if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
+ Tcl_DecrRefCount(objResultPtr);
+ instOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
@@ -4533,12 +4545,6 @@ TEBCresume(
TRACE_APPEND(("ERROR: not command\n"));
goto gotError;
}
- origCmd = TclGetOriginalCommand(cmd);
- if (origCmd == NULL) {
- origCmd = cmd;
- }
- TclNewObj(objResultPtr);
- Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
NEXT_INST_F(1, 1, 1);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 792b675..2f12b8f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1707,18 +1707,18 @@ typedef struct Command {
/*
* Flag bits for commands.
*
- * CMD_IS_DELETED - Means that the command is in the process of
+ * CMD_DYING - If 1 the command is in the process of
* being deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored.
- * CMD_TRACE_ACTIVE - 1 means that trace processing is currently
+ * CMD_TRACE_ACTIVE - If 1 the trace processing is currently
* underway for a rename/delete change. See the
* two flags below for which is currently being
* processed.
- * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one
+ * CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one
* execution trace (as opposed to simple
* delete/rename traces) in its tracePtr list.
- * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that
+ * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that
* can handle expansion (provided it is not the
* first word).
* TCL_TRACE_RENAME - A rename trace is in progress. Further
@@ -1728,7 +1728,7 @@ typedef struct Command {
* (these last two flags are defined in tcl.h)
*/
-#define CMD_IS_DELETED 0x01
+#define CMD_DYING 0x01
#define CMD_TRACE_ACTIVE 0x02
#define CMD_HAS_EXEC_TRACES 0x04
#define CMD_COMPILES_EXPANDED 0x08
@@ -4960,10 +4960,30 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* the internal stubs, but the core can use the macro instead.
*/
-#define TclCleanupCommandMacro(cmdPtr) \
- if ((cmdPtr)->refCount-- <= 1) { \
- ckfree(cmdPtr);\
- }
+#define TclCleanupCommandMacro(cmdPtr) \
+ do { \
+ if ((cmdPtr)->refCount-- <= 1) { \
+ ckfree(cmdPtr); \
+ } \
+ } while (0)
+
+
+/*
+ * inside this routine crement refCount first incase cmdPtr is replacing itself
+ */
+#define TclRoutineAssign(location, cmdPtr) \
+ do { \
+ (cmdPtr)->refCount++; \
+ if ((location) != NULL \
+ && (location--) <= 1) { \
+ ckfree(((location))); \
+ } \
+ (location) = (cmdPtr); \
+ } while (0)
+
+
+#define TclRoutineHasName(cmdPtr) \
+ ((cmdPtr)->hPtr != NULL)
/*
*----------------------------------------------------------------
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 26dca62..673acb0 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1770,6 +1770,8 @@ DoImport(
TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
+ /* corresponding decrement is in DeleteImportedCmd */
+ cmdPtr->refCount++;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
Tcl_DStringFree(&ds);
@@ -2077,6 +2079,7 @@ DeleteImportedCmd(
prevPtr->nextPtr = refPtr->nextPtr;
}
ckfree(refPtr);
+ TclCleanupCommandMacro(realCmdPtr);
ckfree(dataPtr);
return;
}
@@ -3888,7 +3891,7 @@ NamespaceOriginCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Command command, origCommand;
+ Tcl_Command cmd, origCmd;
Tcl_Obj *resultPtr;
if (objc != 2) {
@@ -3896,30 +3899,29 @@ NamespaceOriginCmd(
return TCL_ERROR;
}
- command = Tcl_GetCommandFromObj(interp, objv[1]);
- if (command == NULL) {
+ cmd = Tcl_GetCommandFromObj(interp, objv[1]);
+ if (cmd == NULL) {
+ goto namespaceOriginError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+ TclNewObj(resultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, resultPtr);
+ if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) {
+ Tcl_DecrRefCount(resultPtr);
+ namespaceOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
- origCommand = TclGetOriginalCommand(command);
- TclNewObj(resultPtr);
- if (origCommand == NULL) {
- /*
- * The specified command isn't an imported command. Return the
- * command's name qualified by the full name of the namespace it was
- * defined in.
- */
-
- Tcl_GetCommandFullName(interp, command, resultPtr);
- } else {
- Tcl_GetCommandFullName(interp, origCommand, resultPtr);
- }
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
+
/*
*----------------------------------------------------------------------
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 85f4470..21018ac 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1177,7 +1177,7 @@ ObjectNamespaceDeleted(
* freed memory.
*/
- if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
+ if (((Command *) oPtr->command)->flags && CMD_DYING) {
/*
* Something has already started the command deletion process. We can
* go ahead and clean up the the namespace,
diff --git a/generic/tclObj.c b/generic/tclObj.c
index dbe6686..44b2785 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4667,7 +4667,7 @@ SetCmdNameFromAny(
* report the failure to find the command as an error.
*/
- if (cmdPtr == NULL) {
+ if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-12-26 06:55:50 (GMT)