diff options
| -rw-r--r-- | generic/tclBasic.c | 20 | ||||
| -rw-r--r-- | generic/tclCompile.c | 2 | ||||
| -rw-r--r-- | generic/tclEnsemble.c | 8 | ||||
| -rw-r--r-- | generic/tclExecute.c | 20 | ||||
| -rw-r--r-- | generic/tclInt.h | 38 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 34 | ||||
| -rw-r--r-- | generic/tclOO.c | 2 | ||||
| -rw-r--r-- | generic/tclObj.c | 2 |
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; } |