summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCmdMZ.c21
-rw-r--r--tests/trace.test33
3 files changed, 58 insertions, 1 deletions
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 {}}