diff options
author | dgp <dgp@noemail.net> | 2007-09-07 15:51:24 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2007-09-07 15:51:24 (GMT) |
commit | 9d41a87a6e65a4d04743be29d28f2590933a7ee0 (patch) | |
tree | 1004390eda2e52d8425094b14c5693604de37d1f /generic/tclEvent.c | |
parent | 2b1bf3e58c2191447317a248d00c6848c2585c43 (diff) | |
download | tcl-9d41a87a6e65a4d04743be29d28f2590933a7ee0.zip tcl-9d41a87a6e65a4d04743be29d28f2590933a7ee0.tar.gz tcl-9d41a87a6e65a4d04743be29d28f2590933a7ee0.tar.bz2 |
* generic/tclResult.c (Tcl_GetReturnOptions): Take care that a
* tests/init.test: non-TCL_ERROR code doesn't cause existing
-errorinfo, -errorcode, and -errorline entries to be omitted.
* generic/tclEvent.c: With -errorInfo no longer lost, generate more
complete ::errorInfo when calling [bgerror] after a non-TCL_ERROR
background exception.
FossilOrigin-Name: f4e64b0c796abb30d68ac3011b09e7913e25a937
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r-- | generic/tclEvent.c | 46 |
1 files changed, 20 insertions, 26 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4b37b1e..78b44c2 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.74 2007/09/06 18:13:19 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.75 2007/09/07 15:51:25 dgp Exp $ */ #include "tclInt.h" @@ -356,35 +356,29 @@ TclDefaultBgErrorHandlerObjCmd( tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code); break; } - if (code == TCL_ERROR) { - /* - * Restore important state variables to what they were at the time - * the error occurred. - * - * Need to set the variables, not the interp fields, because - * Tcl_EvalObjv calls Tcl_ResetResult which would destroy - * anything we write to the interp fields. - */ + Tcl_IncrRefCount(tempObjv[1]); - TclNewLiteralStringObj(keyPtr, "-errorcode"); - Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); - Tcl_DecrRefCount(keyPtr); - if (valuePtr) { - Tcl_SetVar2Ex(interp, "errorCode", NULL, valuePtr, TCL_GLOBAL_ONLY); - } + TclNewLiteralStringObj(keyPtr, "-errorcode"); + Tcl_IncrRefCount(keyPtr); + Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + Tcl_DecrRefCount(keyPtr); + if (valuePtr) { + Tcl_SetObjErrorCode(interp, valuePtr); + } - TclNewLiteralStringObj(keyPtr, "-errorinfo"); - Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); - Tcl_DecrRefCount(keyPtr); - if (valuePtr) { - Tcl_SetVar2Ex(interp, "errorInfo", NULL, valuePtr, TCL_GLOBAL_ONLY); + TclNewLiteralStringObj(keyPtr, "-errorinfo"); + Tcl_IncrRefCount(keyPtr); + Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + Tcl_DecrRefCount(keyPtr); + if (valuePtr) { + if (code != TCL_ERROR) { + Tcl_SetObjResult(interp, tempObjv[1]); } - } else { - Tcl_AppendObjToErrorInfo(interp, Tcl_DuplicateObj(tempObjv[1])); + Tcl_IncrRefCount(valuePtr); + Tcl_AppendObjToErrorInfo(interp, valuePtr); } - Tcl_IncrRefCount(tempObjv[1]); + + /* Capture stack trace now, so we can report it if [bgerror] fails. */ valuePtr = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); Tcl_IncrRefCount(valuePtr); |