diff options
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 34 |
1 files changed, 18 insertions, 16 deletions
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; } + /* *---------------------------------------------------------------------- |