summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-10-21 15:19:43 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-10-21 15:19:43 (GMT)
commit302b35c0ac3658a27a30f795d3229e8a43eb5379 (patch)
tree876886b2a00fbe951800502983cfa1c7e9edc97b /generic/tclCmdAH.c
parent0e16d1cc7dd629f7bb9a3d1af174b072e9c8ae6c (diff)
downloadtcl-302b35c0ac3658a27a30f795d3229e8a43eb5379.zip
tcl-302b35c0ac3658a27a30f795d3229e8a43eb5379.tar.gz
tcl-302b35c0ac3658a27a30f795d3229e8a43eb5379.tar.bz2
* generic/tclCmdAH.c (Tcl_CatchObjCmd, Tcl_ErrorObjCmd):
Updated to call the new TclGet/SetReturnOptions routines to do much of their work. * generic/tclInt.h (TclGetReturnOptions,TclSetReturnOptions): * generic/tclResult.c (TclGetReturnOptions,TclSetReturnOptions): New utility routines to get/set the return options of an interp. Intent is that these routines will be converted to public routines after TIP approval. * generic/tclCmdMZ.c (TclProcessReturn,TclMergeReturnOptions): * generic/tclResult.c (TclProcessReturn,TclMergeReturnOptions): Move internal utility routines from tclCmdMZ.c to tclResult.c. * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp): * generic/tclResult.c (TclTransferResult): Rework so that iPtr->returnOpts can be NULL when there are no special options. * generic/tclResult.c (TclRestoreInterpState): Plug potential memory leak.
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c59
1 files changed, 15 insertions, 44 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 8d44139..e3c95bd 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.55 2004/10/18 21:15:35 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.56 2004/10/21 15:19:46 dgp Exp $
*/
#include "tclInt.h"
@@ -269,36 +269,9 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
}
}
if (objc == 4) {
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj *options = Tcl_DuplicateObj(iPtr->returnOpts);
-
- if (result == TCL_RETURN) {
- Tcl_DictObjPut(NULL, options,
- iPtr->returnCodeKey, Tcl_NewIntObj(iPtr->returnCode));
- Tcl_DictObjPut(NULL, options,
- iPtr->returnLevelKey, Tcl_NewIntObj(iPtr->returnLevel));
- } else {
- Tcl_DictObjPut(NULL, options,
- iPtr->returnCodeKey, Tcl_NewIntObj(result));
- Tcl_DictObjPut(NULL, options,
- iPtr->returnLevelKey, Tcl_NewIntObj(0));
- }
-
- if (result == TCL_ERROR) {
- /*
- * When result was an error, fill in any missing values
- * for -errorinfo, -errorcode, and -errorline
- */
- Tcl_DictObjPut(NULL, options,
- iPtr->returnErrorinfoKey, iPtr->errorInfo);
- Tcl_DictObjPut(NULL, options,
- iPtr->returnErrorcodeKey, iPtr->errorCode);
- Tcl_DictObjPut(NULL, options, iPtr->returnErrorlineKey,
- Tcl_NewIntObj(iPtr->errorLine));
- }
-
- if (NULL ==
- Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, 0)) {
+ Tcl_Obj *options = TclGetReturnOptions(interp, result);
+ if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
+ options, 0)) {
Tcl_DecrRefCount(options);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,
@@ -582,31 +555,29 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Interp *iPtr = (Interp *) interp;
- char *info;
- int infoLen;
+ Tcl_Obj *options;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
return TCL_ERROR;
}
+ options = Tcl_NewStringObj("-code error -level 0", -1);
+
if (objc >= 3) { /* process the optional info argument */
- info = Tcl_GetStringFromObj(objv[2], &infoLen);
- if (infoLen > 0) {
- Tcl_AddObjErrorInfo(interp, info, infoLen);
- iPtr->flags |= ERR_ALREADY_LOGGED;
- }
+ Tcl_ListObjAppendElement(NULL, options,
+ Tcl_NewStringObj("-errorinfo", -1));
+ Tcl_ListObjAppendElement(NULL, options, objv[2]);
}
- if (objc == 4) {
- Tcl_SetObjErrorCode(interp, objv[3]);
- } else {
- Tcl_SetErrorCode(interp, "NONE", NULL);
+ if (objc == 4) { /* process the optional code argument */
+ Tcl_ListObjAppendElement(NULL, options,
+ Tcl_NewStringObj("-errorcode", -1));
+ Tcl_ListObjAppendElement(NULL, options, objv[3]);
}
Tcl_SetObjResult(interp, objv[1]);
- return TCL_ERROR;
+ return TclSetReturnOptions(interp, options);
}
/*