summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2002-10-15 16:13:46 (GMT)
committervincentdarley <vincentdarley>2002-10-15 16:13:46 (GMT)
commit0248d22a22c819b43f837351b9e964420120b97e (patch)
tree5fbeddb75c321f3c85725a8140a08a2f3c69c063
parent8ab3cec635aaa48a98d3e2eb1736fa2e1a56ec6d (diff)
downloadtcl-0248d22a22c819b43f837351b9e964420120b97e.zip
tcl-0248d22a22c819b43f837351b9e964420120b97e.tar.gz
tcl-0248d22a22c819b43f837351b9e964420120b97e.tar.bz2
execution trace fix
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclCmdMZ.c41
-rw-r--r--tests/trace.test35
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