diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclTrace.c | 6 | ||||
| -rw-r--r-- | tests/trace.test | 10 |
3 files changed, 20 insertions, 1 deletions
@@ -1,3 +1,8 @@ +2013-02-19 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclTrace.c: [Bug 2438181]: Incorrect error reporting in + * tests/trace.test: traces. Test-case and fix provided by Poor Yorick. + 2013-02-15 Don Porter <dgp@users.sourceforge.net> * generic/regc_nfa.c: [Bug 3604074] Fix regexp optimization to diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 0f297a4..d7430ca 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1485,7 +1485,11 @@ TclCheckExecutionTraces( } iPtr->activeCmdTracePtr = active.nextPtr; if (state) { - Tcl_RestoreInterpState(interp, state); + if (traceCode == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, state); + } else { + Tcl_DiscardInterpState(state); + } } return traceCode; diff --git a/tests/trace.test b/tests/trace.test index b4957c0..41ad00d 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -1670,6 +1670,16 @@ test trace-21.11 {trace execution and alias} -setup { rename ::x {} } -result {:: ::} +proc set2 args { + set {*}$args +} + +test trace-21.12 {bug 2438181} -setup { + trace add execution set2 leave {puts one two three #;} +} -body { + set2 a hello +} -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channelId? string"} + proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } return 1 |