diff options
| author | dgp <dgp@users.sourceforge.net> | 2013-09-05 12:31:46 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2013-09-05 12:31:46 (GMT) |
| commit | db738e7756c64153300dcffb80a3d34ede624623 (patch) | |
| tree | b082adbabe0891b51eda8c866612fef1780ef63f | |
| parent | c6bb98e76328014f65ff65473404b5467cdd3823 (diff) | |
| parent | 2c3dbea378135685d72d688a6ee0fffe633d5376 (diff) | |
| download | tcl-db738e7756c64153300dcffb80a3d34ede624623.zip tcl-db738e7756c64153300dcffb80a3d34ede624623.tar.gz tcl-db738e7756c64153300dcffb80a3d34ede624623.tar.bz2 | |
[010f4162ef] Repair effect of trace errors on -errorinfo and -errorstack.
| -rw-r--r-- | generic/tclBasic.c | 28 | ||||
| -rw-r--r-- | tests/error.test | 10 |
2 files changed, 32 insertions, 6 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 884b5cc..a10a11a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4679,6 +4679,15 @@ TEOV_RunEnterTraces( TclCleanupCommandMacro(cmdPtr); 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; } if (cmdEpoch != newEpoch) { @@ -4699,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); @@ -4714,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. @@ -4725,8 +4731,18 @@ TEOV_RunLeaveTraces( TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { - return traceCode; + 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; + } + 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 |