diff options
author | dgp <dgp@users.sourceforge.net> | 2008-03-10 19:33:12 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2008-03-10 19:33:12 (GMT) |
commit | 91f1d172b9336a459740131d3b779dc252194f1a (patch) | |
tree | 70719859e041998e5da9ae2e7a77e73a04bf5219 /generic/tclEvent.c | |
parent | e295a4ddd722dd78b3dcc40e624b6aad8d05dde8 (diff) | |
download | tcl-91f1d172b9336a459740131d3b779dc252194f1a.zip tcl-91f1d172b9336a459740131d3b779dc252194f1a.tar.gz tcl-91f1d172b9336a459740131d3b779dc252194f1a.tar.bz2 |
merge updates from HEAD
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 2471b72..cb488f0 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.72.2.5 2008/03/07 22:05:04 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.72.2.6 2008/03/10 19:33:12 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]; |