diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclBasic.c | 27 | ||||
| -rw-r--r-- | tests/trace.test | 9 |
3 files changed, 34 insertions, 7 deletions
@@ -1,5 +1,10 @@ 2002-09-05 Don Porter <dgp@users.sourceforge.net> + * generic/tclBasic.c (TclRenameCommand,CallCommandTraces): + * tests/trace.test (trace-27.1): Corrected memory leak when a rename + trace deleted the command being traced. Test added. Thanks to + Hemang Lavana for the fix. [Bug 604609] + * generic/tclVar.c (TclDeleteVars): Corrected logic for setting the TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 379d290..6fe4db2 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.69 2002/08/22 15:57:53 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.70 2002/09/06 00:20:29 dgp Exp $ */ #include "tclInt.h" @@ -2001,6 +2001,13 @@ TclRenameCommand(interp, oldName, newName) return result; } + /* + * Script for rename traces can delete the command "oldName". + * Therefore increment the reference count for cmdPtr so that + * it's Command structure is freed only towards the end of this + * function by calling TclCleanupCommand. + */ + cmdPtr->refCount++; CallCommandTraces(iPtr,cmdPtr,oldName,newName,TCL_TRACE_RENAME); /* @@ -2023,6 +2030,12 @@ TclRenameCommand(interp, oldName, newName) iPtr->compileEpoch++; } + /* + * Now free the Command structure, if the "oldName" command has + * been deleted by invocation of rename traces. + */ + TclCleanupCommand(cmdPtr); + return TCL_OK; } @@ -2523,15 +2536,17 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* * While a rename trace is active, we will not process any more - * rename traces; while a delete trace is active we will not - * process any more delete traces + * 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 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 "oldName" is deleted. */ if (cmdPtr->flags & TCL_TRACE_RENAME) { flags &= ~TCL_TRACE_RENAME; } - if (cmdPtr->flags & TCL_TRACE_DELETE) { - flags &= ~TCL_TRACE_DELETE; - } if (flags == 0) { return NULL; } diff --git a/tests/trace.test b/tests/trace.test index 10c70c9..0c21dc3 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.21 2002/07/29 00:25:50 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.22 2002/09/06 00:20:29 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1830,6 +1830,13 @@ test trace-26.2 {trace targetCmd when invoked through an alias} { set info } {{foo {foo 1 2} enter}} +test trace-27.1 {memory leak in rename trace (604609)} { + catch {rename bar {}} + proc foo {} {error foo} + trace add command foo rename {rename foo "" ;#} + rename foo bar + info commands foo +} {} # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). |