diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-04 07:59:10 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-04 07:59:10 (GMT) |
| commit | 1674055d7a5077032b0ae8c68af6e7593420cdfd (patch) | |
| tree | 5a2b26b3d8c8cca03a5e60c6b1b87979021cac38 /generic/tclNamesp.c | |
| parent | a9843e57c2416046ee657b66dc7bd9e4fba46ff3 (diff) | |
| parent | fd253d8677ffcef7052c8ac03cbd68c656835a35 (diff) | |
| download | tcl-1674055d7a5077032b0ae8c68af6e7593420cdfd.zip tcl-1674055d7a5077032b0ae8c68af6e7593420cdfd.tar.gz tcl-1674055d7a5077032b0ae8c68af6e7593420cdfd.tar.bz2 | |
Merge 8.7
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 86823c4..8770105 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1771,6 +1771,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); @@ -2078,6 +2080,7 @@ DeleteImportedCmd( prevPtr->nextPtr = refPtr->nextPtr; } Tcl_Free(refPtr); + TclCleanupCommandMacro(realCmdPtr); Tcl_Free(dataPtr); return; } @@ -3889,7 +3892,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) { @@ -3897,30 +3900,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; } + /* *---------------------------------------------------------------------- |