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