diff options
Diffstat (limited to 'generic/tclEvent.c')
| -rw-r--r-- | generic/tclEvent.c | 55 |
1 files changed, 41 insertions, 14 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4193ade..dc9705d 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.79 2008/02/29 20:00:00 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.80 2008/03/10 17:54:47 dgp Exp $ */ #include "tclInt.h" @@ -317,30 +317,57 @@ TclDefaultBgErrorHandlerObjCmd( return TCL_ERROR; } - /* Construct the bgerror command */ - TclNewLiteralStringObj(tempObjv[0], "bgerror"); - Tcl_IncrRefCount(tempObjv[0]); - /* - * Determine error message argument. Check the return options in case - * a non-error exception brought us here. + * Check for a valid return options dictionary. */ TclNewLiteralStringObj(keyPtr, "-level"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - Tcl_GetIntFromObj(NULL, valuePtr, &level); + if (valuePtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing return option \"-level\"", -1)); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) { + return TCL_ERROR; + } + TclNewLiteralStringObj(keyPtr, "-code"); + Tcl_IncrRefCount(keyPtr); + Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + Tcl_DecrRefCount(keyPtr); + if (valuePtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing return option \"-code\"", -1)); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) { + return TCL_ERROR; + } + if (level != 0) { /* We're handling a TCL_RETURN exception */ code = TCL_RETURN; - } else { - TclNewLiteralStringObj(keyPtr, "-code"); - Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); - Tcl_DecrRefCount(keyPtr); - Tcl_GetIntFromObj(NULL, valuePtr, &code); } + if (code == TCL_OK) { + /* + * Somehow we got to exception handling with no exception. + * (Pass TCL_OK to TclBackgroundException()?) + * Just return without doing anything. + */ + return TCL_OK; + } + + /* Construct the bgerror command */ + TclNewLiteralStringObj(tempObjv[0], "bgerror"); + Tcl_IncrRefCount(tempObjv[0]); + + /* + * Determine error message argument. Check the return options in case + * a non-error exception brought us here. + */ + switch (code) { case TCL_ERROR: tempObjv[1] = objv[1]; |