summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclBasic.c27
-rw-r--r--tests/trace.test9
3 files changed, 34 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index b537216..56ba05e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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).