summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2015-06-30 14:36:24 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2015-06-30 14:36:24 (GMT)
commitec70ddd4352da0e5022428fed4cfadff606d4334 (patch)
tree10ee02c8ee7135605af4a1826733c1541b87bf45
parenta6d8c6aec1ca797b5ca87d135a09926493b2f256 (diff)
downloadtcl-ec70ddd4352da0e5022428fed4cfadff606d4334.zip
tcl-ec70ddd4352da0e5022428fed4cfadff606d4334.tar.gz
tcl-ec70ddd4352da0e5022428fed4cfadff606d4334.tar.bz2
Correct handling of dictionaries in the background error processing code.
-rw-r--r--generic/tclEvent.c20
1 files 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);
}