From ec70ddd4352da0e5022428fed4cfadff606d4334 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 Jun 2015 14:36:24 +0000 Subject: Correct handling of dictionaries in the background error processing code. --- generic/tclEvent.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index d98685a..dec8289 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -259,7 +259,7 @@ HandleBgErrors( if (errChannel != (Tcl_Channel) NULL) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); - Tcl_Obj *keyPtr, *valuePtr; + Tcl_Obj *keyPtr, *valuePtr = NULL; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); @@ -311,7 +311,7 @@ TclDefaultBgErrorHandlerObjCmd( { Tcl_Obj *keyPtr, *valuePtr; Tcl_Obj *tempObjv[2]; - int code, level; + int result, code, level; Tcl_InterpState saved; if (objc != 3) { @@ -325,9 +325,9 @@ TclDefaultBgErrorHandlerObjCmd( TclNewLiteralStringObj(keyPtr, "-level"); Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - if (valuePtr == NULL) { + if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing return option \"-level\"", -1)); return TCL_ERROR; @@ -337,9 +337,9 @@ TclDefaultBgErrorHandlerObjCmd( } TclNewLiteralStringObj(keyPtr, "-code"); Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - if (valuePtr == NULL) { + if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing return option \"-code\"", -1)); return TCL_ERROR; @@ -394,17 +394,17 @@ TclDefaultBgErrorHandlerObjCmd( TclNewLiteralStringObj(keyPtr, "-errorcode"); Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - if (valuePtr) { + if (result == TCL_OK && valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - if (valuePtr) { + if (result == TCL_OK && valuePtr != NULL) { Tcl_AppendObjToErrorInfo(interp, valuePtr); } -- cgit v0.12