execution trace fix

3 files changed, 75 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 3eba000..dc6c6aa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-10-15  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclCmdMZ.c:
+	* tests/trace.test: applied patch from Hemang Levana to fix
+	[Bug #615043] in execution traces with idle tasks firing.
+
 2002-10-14  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak.
@@ -24,7 +30,7 @@
 	
 	* doc/regexp.n:	Typo correction.  Thanks Ronnie Brunner. [Bug 606826]
 
-2002-07-22  Vince Darley  <vincentdarley@users.sourceforge.net>
+2002-10-10  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* unix/tclLoadAout.c
 	* unix/tclLoadDl.c
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f053f33..fc6ad98 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.76 2002/08/22 15:57:54 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.77 2002/10/15 16:13:46 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -46,7 +46,12 @@ typedef struct {
     size_t length;		/* Number of non-NULL chars. in command. */
     Tcl_Trace stepTrace;        /* Used for execution traces, when tracing
                                  * inside the given command */
-    int startLevel;             /* Used for bookkeeping with execution traces */
+    int startLevel;             /* Used for bookkeeping with step execution
+                                 * traces, store the level at which the step
+                                 * trace was invoked */
+    char *startCmd;             /* Used for bookkeeping with step execution
+                                 * traces, store the command name which invoked
+                                 * step trace */
     int curFlags;               /* Trace flags for the current command */
     int curCode;                /* Return code for the current command */
     char command[4];		/* Space for Tcl command to invoke.  Actual
@@ -3187,6 +3192,7 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
 		tcmdPtr->flags = flags;
 		tcmdPtr->stepTrace = NULL;
 		tcmdPtr->startLevel = 0;
+		tcmdPtr->startCmd = NULL;
 		tcmdPtr->length = length;
 		flags |= TCL_TRACE_DELETE;
 		if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) {
@@ -3236,6 +3242,9 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
 			     */
 			    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 			    tcmdPtr->stepTrace = NULL;
+                            if (tcmdPtr->startCmd != NULL) {
+			        ckfree((char *)tcmdPtr->startCmd);
+			    }
 			}
 			/* Postpone deletion */
 			if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -3388,6 +3397,7 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
 		tcmdPtr->flags = flags;
 		tcmdPtr->stepTrace = NULL;
 		tcmdPtr->startLevel = 0;
+		tcmdPtr->startCmd = NULL;
 		tcmdPtr->length = length;
 		flags |= TCL_TRACE_DELETE;
 		strcpy(tcmdPtr->command, command);
@@ -3963,6 +3973,9 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
 	if (tcmdPtr->stepTrace != NULL) {
 	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 	    tcmdPtr->stepTrace = NULL;
+            if (tcmdPtr->startCmd != NULL) {
+	        ckfree((char *)tcmdPtr->startCmd);
+	    }
 	}
 	/* Postpone deletion, until exec trace returns */
 	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -4289,14 +4302,18 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
 	}
 	/*
 	 * First, if we have returned back to the level at which we
-	 * created an interpreter trace, we remove it
+	 * created an interpreter trace for enterstep and/or leavestep
+         * execution traces, we remove it here.
 	 */
 	if (flags & TCL_TRACE_LEAVE_EXEC) {
-	    if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)) {
+	    if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)
+                && (strcmp(command, tcmdPtr->startCmd) == 0)) {
 		Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 		tcmdPtr->stepTrace = NULL;
+                if (tcmdPtr->startCmd != NULL) {
+	            ckfree((char *)tcmdPtr->startCmd);
+	        }
 	    }
-	    
 	}
 	
 	/*
@@ -4381,12 +4398,19 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
 	}
 	
 	/*
-	 * Third, create an interpreter trace, if we need one for
-	 * subsequent internal execution traces.
+	 * Third, if there are any step execution traces for this proc,
+         * we register an interpreter trace to invoke enterstep and/or
+	 * leavestep traces.
+	 * We also need to save the current stack level and the proc
+         * string in startLevel and startCmd so that we can delete this
+         * interpreter trace when it reaches the end of this proc.
 	 */
 	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
 	    && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) {
 		tcmdPtr->startLevel = level;
+		tcmdPtr->startCmd = 
+		    (char *) ckalloc((unsigned) (strlen(command) + 1));
+		strcpy(tcmdPtr->startCmd, command);
 		tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
 		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, 
 		   TraceExecutionProc, (ClientData)tcmdPtr, NULL);
@@ -4396,6 +4420,9 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
 	if (tcmdPtr->stepTrace != NULL) {
 	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 	    tcmdPtr->stepTrace = NULL;
+            if (tcmdPtr->startCmd != NULL) {
+	        ckfree((char *)tcmdPtr->startCmd);
+	    }
 	}
 	Tcl_EventuallyFree((ClientData)tcmdPtr, TCL_DYNAMIC);
     }
diff --git a/tests/trace.test b/tests/trace.test
index 0c21dc3..f72b0bd 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.22 2002/09/06 00:20:29 dgp Exp $
+# RCS: @(#) $Id: trace.test,v 1.23 2002/10/15 16:13:47 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1838,12 +1838,45 @@ test trace-27.1 {memory leak in rename trace (604609)} {
     info commands foo
 } {}
 
+test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} {
+    catch {rename foo {}}
+    proc foo {} {
+        set a 1
+        update idletasks
+        set b 1
+    }
+
+    set info {}
+    trace add execution foo {enter enterstep leavestep leave} \
+        [list traceExecute foo]
+    update
+    after idle {puts idle}
+    foo
+
+    trace remove execution foo {enter enterstep leavestep leave} \
+        [list traceExecute foo]
+    rename foo {}
+    join $info "\n"
+} {foo foo enter
+foo {set a 1} enterstep
+foo {set a 1} 0 1 leavestep
+foo {update idletasks} enterstep
+foo {puts idle} enterstep
+foo {puts idle} 0 {} leavestep
+foo {update idletasks} 0 {} leavestep
+foo {set b 1} enterstep
+foo {set b 1} 0 1 leavestep
+foo foo 0 1 leave}
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}
 catch {rename foo {}}
 catch {rename bar {}}
 
+# Unset the varaible when done
+catch {unset info}
+
 # cleanup
 ::tcltest::cleanupTests
 return