diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2002-07-18 13:37:43 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2002-07-18 13:37:43 (GMT) |
commit | 20f90f51f25cf3474e10150eebc6f1e23f68a0db (patch) | |
tree | c705d24b3b5659bc7a1a9401116481ab0b1e5717 /generic/tclBasic.c | |
parent | a8c7a255122a3ad4f7bbbc63f3e53e4f8b0569f4 (diff) | |
download | tcl-20f90f51f25cf3474e10150eebc6f1e23f68a0db.zip tcl-20f90f51f25cf3474e10150eebc6f1e23f68a0db.tar.gz tcl-20f90f51f25cf3474e10150eebc6f1e23f68a0db.tar.bz2 |
* generic/tclBasic.c (CallCommandTraces): delete traces now receive
the FQ old name of the command. [Bug 582532] (Don Porter)
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b60a6c3..86730ab 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.63 2002/07/16 01:12:50 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.64 2002/07/18 13:37:45 msofer Exp $ */ #include "tclInt.h" @@ -2518,6 +2518,8 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) register CommandTrace *tracePtr; ActiveCommandTrace active; char *result; + Tcl_Obj *oldNamePtr = NULL; + if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* * While a rename trace is active, we will not process any more @@ -2554,8 +2556,11 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) } cmdPtr->flags |= tracePtr->flags; if (oldName == NULL) { - oldName = Tcl_GetCommandName((Tcl_Interp *) iPtr, - (Tcl_Command) cmdPtr); + TclNewObj(oldNamePtr); + Tcl_IncrRefCount(oldNamePtr); + Tcl_GetCommandFullName((Tcl_Interp *) iPtr, + (Tcl_Command) cmdPtr, oldNamePtr); + oldName = TclGetString(oldNamePtr); } Tcl_Preserve((ClientData) tracePtr); (*tracePtr->traceProc)(tracePtr->clientData, @@ -2565,6 +2570,15 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) } /* + * If a new object was created to hold the full oldName, + * free it now. + */ + + if (oldNamePtr != NULL) { + TclDecrRefCount(oldNamePtr); + } + + /* * Restore the variable's flags, remove the record of our active * traces, and then return. */ |