diff options
| author | dgp <dgp@users.sourceforge.net> | 2013-09-02 18:47:07 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2013-09-02 18:47:07 (GMT) |
| commit | 2c3dbea378135685d72d688a6ee0fffe633d5376 (patch) | |
| tree | 27a8b5d15d20dd51cf3d1104f7512dc8638602fc /generic/tclBasic.c | |
| parent | 8520e69f3213d9c34e39b16438ff5933e874a320 (diff) | |
| download | tcl-2c3dbea378135685d72d688a6ee0fffe633d5376.zip tcl-2c3dbea378135685d72d688a6ee0fffe633d5376.tar.gz tcl-2c3dbea378135685d72d688a6ee0fffe633d5376.tar.bz2 | |
Add test and improve errorInfo.
Diffstat (limited to 'generic/tclBasic.c')
| -rw-r--r-- | generic/tclBasic.c | 22 |
1 files changed, 16 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; } |