diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 21 | ||||
| -rw-r--r-- | tests/trace.test | 33 |
3 files changed, 58 insertions, 1 deletions
@@ -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 {}} |