diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-02-19 10:34:31 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-02-19 10:34:31 (GMT) |
| commit | 7ba8e6119017551866f531be022705ef17a1ed39 (patch) | |
| tree | d9b723448fa129576c7c0f10cf38f54211381ab6 | |
| parent | d14317916c9328450a7afd6cfa2168a6c5a7224f (diff) | |
| parent | ee8be54ede03c2d1f37f4639dcff5b9a94722992 (diff) | |
| download | tcl-7ba8e6119017551866f531be022705ef17a1ed39.zip tcl-7ba8e6119017551866f531be022705ef17a1ed39.tar.gz tcl-7ba8e6119017551866f531be022705ef17a1ed39.tar.bz2 | |
Fix bug #2438181: Incorrect error reporting in traces.
Test-case and fix provided by Poor Yorick.
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclTrace.c | 10 | ||||
| -rw-r--r-- | tests/trace.test | 10 |
3 files changed, 22 insertions, 3 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 fa29160..fd7566d 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1481,7 +1481,11 @@ TclCheckExecutionTraces( } iPtr->activeCmdTracePtr = active.nextPtr; if (state) { - (void) Tcl_RestoreInterpState(interp, state); + if (traceCode == TCL_OK) { + traceCode = Tcl_RestoreInterpState(interp, state); + } else { + Tcl_DiscardInterpState(state); + } } return(traceCode); @@ -1628,7 +1632,7 @@ TclCheckInterpTraces( iPtr->activeInterpTracePtr = active.nextPtr; if (state) { if (traceCode == TCL_OK) { - (void) Tcl_RestoreInterpState(interp, state); + traceCode = Tcl_RestoreInterpState(interp, state); } else { Tcl_DiscardInterpState(state); } @@ -2722,7 +2726,7 @@ TclCallVarTraces( iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_DiscardInterpState(state); } else { - (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state); + code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state); } DisposeTraceResult(disposeFlags,result); } else if (state) { diff --git a/tests/trace.test b/tests/trace.test index 9c3a686..27e23c4 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -1667,6 +1667,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 |