From bfee748b41a556c2c213d22b99ce12b156acb1d8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 2 Sep 2013 18:47:07 +0000
Subject: Add test and improve errorInfo.

---
 generic/tclBasic.c | 22 ++++++++++++++++------
 tests/error.test   | 10 ++++++++++
 2 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e909a1a..a10a11a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4680,6 +4680,12 @@ TEOV_RunEnterTraces(
 
     if (traceCode != TCL_OK) {
 	if (traceCode == TCL_ERROR) {
+	    Tcl_Obj *info;
+
+	    TclNewLiteralStringObj(info, "\n    (enter trace on \"");
+	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+	    Tcl_AppendToObj(info, "\")", 2);
+	    Tcl_AppendObjToErrorInfo(interp, info);
 	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
 	return traceCode;
@@ -4702,12 +4708,10 @@ TEOV_RunLeaveTraces(
     Tcl_Obj *commandPtr = data[1];
     Command *cmdPtr = data[2];
     Tcl_Obj **objv = data[3];
-
+    int length;
+    const char *command = Tcl_GetStringFromObj(commandPtr, &length);
 
     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	int length;
-	const char *command = Tcl_GetStringFromObj(commandPtr, &length);
-
 	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
 	    traceCode = TclCheckExecutionTraces(interp, command, length,
 		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -4717,7 +4721,6 @@ TEOV_RunLeaveTraces(
 		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
 	}
     }
-    Tcl_DecrRefCount(commandPtr);
 
     /*
      * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
@@ -4729,10 +4732,17 @@ TEOV_RunLeaveTraces(
 
     if (traceCode != TCL_OK) {
 	if (traceCode == TCL_ERROR) {
+	    Tcl_Obj *info;
+
+	    TclNewLiteralStringObj(info, "\n    (leave trace on \"");
+	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+	    Tcl_AppendToObj(info, "\")", 2);
+	    Tcl_AppendObjToErrorInfo(interp, info);
 	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
-	return traceCode;
+	result = traceCode;
     }
+    Tcl_DecrRefCount(commandPtr);
     return result;
 }
 
diff --git a/tests/error.test b/tests/error.test
index 06f8eca..0de644c 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -182,6 +182,16 @@ test error-4.7 {errorstack via options dict } -body {
     catch {f 12} m d
     dict get $d -errorstack
 } -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
+test error-4.8 {errorstack from exec traces} -body {
+    proc foo args {}
+    proc goo {} foo
+    trace add execution foo enter {error bar;#}
+    catch goo m d
+    dict get $d -errorstack
+} -cleanup {
+    rename goo {}; rename foo {}
+    unset -nocomplain m d
+} -result {INNER {error bar} CALL goo UP 1}
 
 # Errors in error command itself
 
-- 
cgit v0.12