diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 15 | ||||
| -rw-r--r-- | tests/trace.test | 39 |
3 files changed, 53 insertions, 6 deletions
@@ -1,3 +1,8 @@ +2006-04-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCmdMZ.c: Stop some interference between enter traces + * tests/trace.test: and enterstep traces. [Bug 1458266] + 2006-04-10 Don Porter <dgp@users.sourceforge.net> *** 8.4.13 TAGGED FOR RELEASE *** diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 9aaa6cb..1613799 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.82.2.25 2005/11/18 23:07:27 msofer Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.26 2006/04/11 14:37:04 dgp Exp $ */ #include "tclInt.h" @@ -4579,10 +4579,9 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, */ if (call) { Tcl_SavedResult state; - int stateCode; + int stateCode, i, saveInterpFlags; Tcl_DString cmd; Tcl_DString sub; - int i; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); @@ -4636,8 +4635,9 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, Tcl_SaveResult(interp, &state); stateCode = iPtr->returnCode; - 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++; /* * This line can have quite arbitrary side-effects, @@ -4646,7 +4646,12 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, */ 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; } diff --git a/tests/trace.test b/tests/trace.test index 21536ad..a85bda2 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.26.2.15 2006/02/28 15:44:36 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.26.2.16 2006/04/11 14:37:05 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -2325,6 +2325,43 @@ test trace-34.5 {Bug 1047286} { 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 + # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} |