Fix bug #2438181: Incorrect error reporting in traces.

Test-case and fix provided by Poor Yorick.

3 files changed, 20 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 5993378..d221786 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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