From ff4a267f0be445ca56e06e36c671c793b307814d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 6 Sep 2002 00:20:29 +0000
Subject:         * 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]

---
 ChangeLog          |  5 +++++
 generic/tclBasic.c | 27 +++++++++++++++++++++------
 tests/trace.test   |  9 ++++++++-
 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).
-- 
cgit v0.12