* generic/tclCmdMZ.c: Stop some interference between enter traces

        * tests/trace.test:     and enterstep traces.  [Bug 1458266]

1 files changed, 38 insertions, 1 deletions

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 {}}