summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormig <mig>2012-02-06 16:46:17 (GMT)
committermig <mig>2012-02-06 16:46:17 (GMT)
commit234e0816da7ffb6d8d3691f6fac55f330285ef10 (patch)
tree61bb17debaf1681940374fbcaff97b26005846c3
parent1b8b1325832f5d25e6db0c5b7839dada981562f5 (diff)
parent3726e1f19cfa86bd6348c60bc1b600512748db4f (diff)
downloadtcl-234e0816da7ffb6d8d3691f6fac55f330285ef10.zip
tcl-234e0816da7ffb6d8d3691f6fac55f330285ef10.tar.gz
tcl-234e0816da7ffb6d8d3691f6fac55f330285ef10.tar.bz2
Fix for [Bug 3484621]: insure that execution traces on bytecoded commands bump the interp's compile epoch.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclTrace.c19
-rw-r--r--tests/trace.test33
3 files changed, 58 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog
index 9f5ea09..26749ed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-02-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclTrace.c: Fix for [Bug 3484621]: insure that
+ * tests/trace.test: execution traces on bytecoded commands bump
+ the interp's compile epoch.
+
2012-02-02 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclUniData.c: [Frq 3464401] Support Unicode 6.1
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 13359ee..c1cae76 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1126,6 +1126,16 @@ Tcl_TraceCommand(
if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
}
+
+ /*
+ * Bug 3484621: up the interp's epoch if this is a BC'ed command
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ Interp *iPtr = (Interp *) interp;
+ iPtr->compileEpoch++;
+ }
+
return TCL_OK;
}
@@ -1228,6 +1238,15 @@ Tcl_UntraceCommand(
*/
cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
+
+ /*
+ * Bug 3484621: up the interp's epoch if this is a BC'ed command
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ Interp *iPtr = (Interp *) interp;
+ iPtr->compileEpoch++;
+ }
}
}
diff --git a/tests/trace.test b/tests/trace.test
index 5767860..254ff62 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -2558,6 +2558,39 @@ set base {
}
runbase {{- *} {-* *} {- *} {- *}} $base
+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
+
+ list $::traceCalls | {*}$res
+} -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