diff options
| author | dgp@users.sourceforge.net <dgp> | 2012-02-06 17:34:46 (GMT) |
|---|---|---|
| committer | dgp@users.sourceforge.net <dgp> | 2012-02-06 17:34:46 (GMT) |
| commit | a8ff0547b6eb24fc51410a8c04035780c9a3d2da (patch) | |
| tree | b31b139861ec809d5c687061eca9f1761767271d | |
| parent | 41698b252cc772fc6eddcce563cc087e455d5d1e (diff) | |
| parent | 82c57bb1614f5827386d1fdb0dc861105ba44faf (diff) | |
| download | tcl-a8ff0547b6eb24fc51410a8c04035780c9a3d2da.zip tcl-a8ff0547b6eb24fc51410a8c04035780c9a3d2da.tar.gz tcl-a8ff0547b6eb24fc51410a8c04035780c9a3d2da.tar.bz2 | |
3485022 TclCompileEnsemble() avoid compile when exec traces set.
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 3 | ||||
| -rw-r--r-- | tests/trace.test | 28 |
3 files changed, 35 insertions, 1 deletions
@@ -1,3 +1,8 @@ +2012-02-06 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompCmds.c: [Bug 3485022] TclCompileEnsemble() avoid + * tests/trace.test: compile when exec traces set. + 2012-02-06 Miguel Sofer <msofer@users.sf.net> * generic/tclTrace.c: Fix for [Bug 3484621]: insure that diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index f2d1bfb..76181ee 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -6325,7 +6325,8 @@ TclCompileEnsemble( Tcl_IncrRefCount(targetCmdObj); cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj); TclDecrRefCount(targetCmdObj); - if (cmdPtr == NULL || cmdPtr->compileProc == NULL) { + if (cmdPtr == NULL || cmdPtr->compileProc == NULL + || cmdPtr->flags & CMD_HAS_EXEC_TRACES) { /* * Maps to an undefined command or a command without a compiler. * Cannot compile. diff --git a/tests/trace.test b/tests/trace.test index 3297258..b1202b8 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -2591,8 +2591,36 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup { rename foo {} } -result {3 | 0 1 1} +test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup { + set ::traceLog 0 + set ::traceCalls 0 + set res {} + proc dotrace args { + incr ::traceLog + } + proc foo {} { + incr ::traceCalls + string equal zip zap + } +} -body { + foo + lappend res $::traceLog + trace add execution ::tcl::string::equal enter dotrace + foo + lappend res $::traceLog + + trace remove execution tcl::string::equal enter dotrace + foo + lappend res $::traceLog + list $::traceCalls | {*}$res +} -cleanup { + unset ::traceLog ::traceCalls 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 {}} |