Attachment "1458826-85.patch" to
ticket [1458266fff]
added by
dgp
2006-04-11 21:22:37.
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.32
diff -u -r1.32 tclTrace.c
--- generic/tclTrace.c 9 Jan 2006 09:31:58 -0000 1.32
+++ generic/tclTrace.c 11 Apr 2006 14:18:58 -0000
@@ -1789,7 +1789,7 @@
if (call) {
Tcl_DString cmd;
Tcl_DString sub;
- int i;
+ int i, saveInterpFlags;
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
@@ -1852,8 +1852,9 @@
* returns.
*/
- tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+ saveInterpFlags = iPtr->flags;
iPtr->flags |= INTERP_TRACE_IN_PROGRESS;
+ tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
tcmdPtr->refCount++;
/*
@@ -1864,7 +1865,12 @@
traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
- iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS;
+
+ /*
+ * Restore the interp tracing flag to prevent cmd traces
+ * from affecting interp traces.
+ */
+ iPtr->flags = saveInterpFlags;
if (tcmdPtr->flags == 0) {
flags |= TCL_TRACE_DESTROYED;
}
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.48
diff -u -r1.48 trace.test
--- tests/trace.test 28 Feb 2006 15:47:10 -0000 1.48
+++ tests/trace.test 11 Apr 2006 14:19:00 -0000
@@ -2391,6 +2391,43 @@
set x
} {::foo::bar exists: }
+test trace-34.6 {Bug 1458266} -setup {
+ proc dummy {} {}
+ proc stepTraceHandler {cmdString args} {
+ variable log
+ append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n"
+ dummy
+ isTracedInside_2
+ }
+ proc cmdTraceHandler {cmdString args} {
+ # silent
+ }
+ proc isTracedInside_1 {} {
+ isTracedInside_2
+ }
+ proc isTracedInside_2 {} {
+ set x 2
+ }
+} -body {
+ variable log {}
+ trace add execution isTracedInside_1 enterstep stepTraceHandler
+ trace add execution isTracedInside_2 enterstep stepTraceHandler
+ isTracedInside_1
+ variable first $log
+ set log {}
+ trace add execution dummy enter cmdTraceHandler
+ isTracedInside_1
+ variable second $log
+ expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"}
+} -cleanup {
+ unset -nocomplain log first second
+ rename dummy {}
+ rename stepTraceHandler {}
+ rename cmdTraceHandler {}
+ rename isTracedInside_1 {}
+ rename isTracedInside_2 {}
+} -result ok
+
test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
unset -nocomplain x y
} -body {
