diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 59 | ||||
| -rw-r--r-- | generic/tclProc.c | 16 |
3 files changed, 36 insertions, 45 deletions
@@ -1,5 +1,11 @@ 2004-10-15 Don Porter <dgp@users.sourceforge.net> + * generic/tclCmdMZ.c (TclProcessReturn): Now that primary + * generic/tclProc.c (TclUpdateReturnInfo): storage for the + errorInfo and errorCode values are internal fields, we can set + them at the time of the [return] command, and not have to wait + until the specified number of "-level"s have popped. + * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp, TclEvalObjvInternal,Tcl_LogCommandInfo,TclAddObjErrorInfo): * generic/tclCmdAH.c (Tcl_CatchObjCmd): diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index a408db6..3fba9fc 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.112 2004/10/15 04:01:28 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.113 2004/10/15 21:02:35 dgp Exp $ */ #include "tclInt.h" @@ -901,37 +901,36 @@ TclProcessReturn(interp, code, level, returnOpts) Tcl_IncrRefCount(iPtr->returnOpts); } - if (level == 0) { - if (code == TCL_ERROR) { - valuePtr = NULL; - Tcl_DictObjGet(NULL, iPtr->returnOpts, - iPtr->returnErrorinfoKey, &valuePtr); - if (valuePtr != NULL) { - int infoLen; - CONST char *info = Tcl_GetStringFromObj(valuePtr, &infoLen); - if (infoLen) { - Tcl_AddObjErrorInfo(interp, info, infoLen); - iPtr->flags |= ERR_ALREADY_LOGGED; - } - } - valuePtr = NULL; - Tcl_DictObjGet(NULL, iPtr->returnOpts, - iPtr->returnErrorcodeKey, &valuePtr); - if (valuePtr != NULL) { - Tcl_SetObjErrorCode(interp, valuePtr); - } else { - Tcl_SetErrorCode(interp, "NONE", NULL); - } + if (code == TCL_ERROR) { + valuePtr = NULL; + Tcl_DictObjGet(NULL, iPtr->returnOpts, + iPtr->returnErrorinfoKey, &valuePtr); + if (valuePtr != NULL) { + int infoLen; + CONST char *info = Tcl_GetStringFromObj(valuePtr, &infoLen); + if (infoLen) { + Tcl_AddObjErrorInfo(interp, info, infoLen); + iPtr->flags |= ERR_ALREADY_LOGGED; + } + } + valuePtr = NULL; + Tcl_DictObjGet(NULL, iPtr->returnOpts, + iPtr->returnErrorcodeKey, &valuePtr); + if (valuePtr != NULL) { + Tcl_SetObjErrorCode(interp, valuePtr); + } else { + Tcl_SetErrorCode(interp, "NONE", NULL); + } - valuePtr = NULL; - Tcl_DictObjGet(NULL, iPtr->returnOpts, - iPtr->returnErrorlineKey, &valuePtr); - if (valuePtr != NULL) { - Tcl_GetIntFromObj(NULL, valuePtr, &iPtr->errorLine); - } + valuePtr = NULL; + Tcl_DictObjGet(NULL, iPtr->returnOpts, + iPtr->returnErrorlineKey, &valuePtr); + if (valuePtr != NULL) { + Tcl_GetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } - } else { - code = TCL_RETURN; + } + if (level != 0) { + return TCL_RETURN; } return code; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 1be2e09..3756024 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.60 2004/10/15 04:01:33 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.61 2004/10/15 21:02:36 dgp Exp $ */ #include "tclInt.h" @@ -1471,20 +1471,6 @@ TclUpdateReturnInfo(iPtr) Tcl_DictObjGet(NULL, iPtr->returnOpts, iPtr->returnCodeKey, &valuePtr); Tcl_GetIntFromObj(NULL, valuePtr, &code); } - if (code == TCL_ERROR) { - Tcl_DictObjGet(NULL, iPtr->returnOpts, - iPtr->returnErrorcodeKey, &valuePtr); - if (valuePtr != NULL) { - Tcl_SetObjErrorCode((Tcl_Interp *)iPtr, valuePtr); - } - - Tcl_DictObjGet(NULL, iPtr->returnOpts, - iPtr->returnErrorinfoKey, &valuePtr); - if (valuePtr != NULL) { - iPtr->errorInfo = valuePtr; - Tcl_IncrRefCount(iPtr->errorInfo); - } - } return code; } |