From a6c8df42563b94d6f02b77f4b894c63f36f35f56 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Apr 2006 14:37:53 +0000
Subject:         * generic/tclTrace.c:   Stop some interference between enter
 traces         * tests/trace.test:     and enterstep traces.  [Bug 1458266]

---
 ChangeLog          |  5 +++++
 generic/tclTrace.c | 14 ++++++++++----
 tests/trace.test   | 39 ++++++++++++++++++++++++++++++++++++++-
 3 files changed, 53 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index f28550e..ca3886e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2006-04-11  Don Porter  <dgp@users.sourceforge.net>
+
+        * generic/tclTrace.c:   Stop some interference between enter traces
+        * tests/trace.test:     and enterstep traces.  [Bug 1458266]
+
 2006-04-07  Don Porter  <dgp@users.sourceforge.net>
 
 	*** 8.5a4 TAGGED FOR RELEASE ***
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 48cd1db..65c53f8 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -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: tclTrace.c,v 1.32 2006/01/09 09:31:58 dkf Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.33 2006/04/11 14:37:54 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1789,7 +1789,7 @@ TraceExecutionProc(
 	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 @@ TraceExecutionProc(
 	     * 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 @@ TraceExecutionProc(
 
 	    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 657c86a..a6afc4e 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.48 2006/02/28 15:47:10 dgp Exp $
+# RCS: @(#) $Id: trace.test,v 1.49 2006/04/11 14:37:54 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2391,6 +2391,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
+
 test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
     unset -nocomplain x y
 } -body {
-- 
cgit v0.12