diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-07 13:40:43 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-07 13:40:43 (GMT) |
| commit | 5cf272491e7c2481d4267745ef2b61c62f12838c (patch) | |
| tree | e8b9ce879f91a9c3dc3ae49de0063427af90a5e0 /generic/tclNamesp.c | |
| parent | 264c574c2318f22417646a35593e266af7053952 (diff) | |
| parent | 45e00e9df8512ac5dc2e17df020f5269fc76a0a5 (diff) | |
| download | tcl-5cf272491e7c2481d4267745ef2b61c62f12838c.zip tcl-5cf272491e7c2481d4267745ef2b61c62f12838c.tar.gz tcl-5cf272491e7c2481d4267745ef2b61c62f12838c.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..bf59eac 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; } + /* *---------------------------------------------------------------------- |