From 5894df49560c27bd2e8a613912674b7f6392ae84 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 6 Feb 2012 17:21:56 +0000
Subject: 3484621 Invalidate bytecode when exec traces are added/removed from
 compiled cmd.

---
 ChangeLog          |  5 +++++
 generic/tclCmdMZ.c | 21 ++++++++++++++++++++-
 tests/trace.test   | 33 +++++++++++++++++++++++++++++++++
 3 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 699f2e9..5c46456 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-02-06  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCmdMZ.c:	[Bug 3484621] Invalidate bytecode when exec
+	* tests/trace.test:	traces are added/removed from compiled cmd.
+
 2012-02-02  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclUniData.c: [Frq 3464401] Support Unicode 6.1
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 27e4055..fb15062 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4019,8 +4019,18 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
     tracePtr->nextPtr = cmdPtr->tracePtr;
     tracePtr->refCount = 1;
     cmdPtr->tracePtr = tracePtr;
-    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+    if ((tracePtr->flags & TCL_TRACE_ANY_EXEC) 
+	    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
         cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
+
+	/*
+	 * Bug 3484621: New execution trace means we no longer compile
+	 * this command if we normally would.  Invalidate bytecode.
+	 */
+
+	if (cmdPtr->compileProc != NULL) {
+	    ((Interp *)interp)->compileEpoch++;
+	}
     }
     return TCL_OK;
 }
@@ -4123,6 +4133,15 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
 	 * traces.  We therefore remove this flag:
 	 */
 	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
+
+	/*
+	 * Bug 3484621: No more execution trace means we can compile
+	 * the command again.  If we will, invalidate bytecode.
+	 */
+
+	if (cmdPtr->compileProc != NULL) {
+	    ((Interp *)interp)->compileEpoch++;
+	}
     }
 }
 
diff --git a/tests/trace.test b/tests/trace.test
index 1555d63..80bdb4a 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -2404,6 +2404,39 @@ test trace-34.6 {Bug 1458266} -setup {
     rename isTracedInside_2 {}
 } -result ok
 
+test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
+    set ::traceLog 0
+    set ::traceCalls 0
+    set ::bar [list 0 1 2 3]
+    set res {}
+    proc dotrace args {
+        incr ::traceLog
+    }
+    proc foo {} {
+        incr ::traceCalls
+        # choose a BC'ed command that is 'unlikely' to interfere with tcltest's
+        # internals
+        lset ::bar 1 2
+    }
+} -body {
+    foo
+    lappend res $::traceLog
+
+    trace add execution lset enter dotrace
+    foo
+    lappend res $::traceLog
+
+    trace remove execution lset enter dotrace
+    foo
+    lappend res $::traceLog
+
+    linsert $res 0 $::traceCalls |
+} -cleanup {
+    unset ::traceLog ::traceCalls ::bar res
+    rename dotrace {}
+    rename foo {}
+} -result {3 | 0 1 1}
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}
-- 
cgit v0.12