summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c69
1 files changed, 62 insertions, 7 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 0536dd2..3731974 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.31 2003/04/16 23:33:43 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.32 2003/05/05 20:54:38 dgp Exp $
*/
#include "tclInt.h"
@@ -234,10 +234,12 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Obj *varNamePtr = NULL;
+ Tcl_Obj *optionVarNamePtr = NULL;
int result;
- if ((objc != 2) && (objc != 3)) {
- Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "script ?resultVarName? ?optionVarName?");
return TCL_ERROR;
}
@@ -247,21 +249,74 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
* stack rendering objv invalid.
*/
- if (objc == 3) {
+ if (objc >= 3) {
varNamePtr = objv[2];
}
+ if (objc == 4) {
+ optionVarNamePtr = objv[3];
+ }
result = Tcl_EvalObjEx(interp, objv[1], 0);
- if (objc == 3) {
- if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
- Tcl_GetObjResult(interp), 0) == NULL) {
+ if (objc >= 3) {
+ if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+ Tcl_GetObjResult(interp), 0)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"couldn't save command result in variable", -1);
return TCL_ERROR;
}
}
+ if (objc == 4) {
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *options = Tcl_DuplicateObj(iPtr->returnOpts);
+ Tcl_Obj *value = NULL;
+
+ if (result != TCL_RETURN) {
+ Tcl_DictObjPut(NULL, options,
+ iPtr->returnCodeKey, Tcl_NewIntObj(result));
+ Tcl_DictObjPut(NULL, options,
+ iPtr->returnLevelKey, Tcl_NewIntObj(0));
+ }
+
+ if (iPtr->flags & ERR_IN_PROGRESS) {
+ value = NULL;
+ Tcl_DictObjGet(NULL, options, iPtr->returnErrorinfoKey, &value);
+ if (NULL == value) {
+ Tcl_DictObjPut(NULL, options, iPtr->returnErrorinfoKey,
+ Tcl_ObjGetVar2(interp, iPtr->execEnvPtr->errorInfo,
+ NULL, TCL_GLOBAL_ONLY));
+ }
+ }
+
+ if (iPtr->flags & ERROR_CODE_SET) {
+ value = NULL;
+ Tcl_DictObjGet(NULL, options, iPtr->returnErrorcodeKey, &value);
+ if (NULL == value) {
+ Tcl_DictObjPut(NULL, options, iPtr->returnErrorcodeKey,
+ Tcl_ObjGetVar2(interp, iPtr->execEnvPtr->errorCode,
+ NULL, TCL_GLOBAL_ONLY));
+ }
+ }
+
+ if (result == TCL_ERROR) {
+ value = NULL;
+ Tcl_DictObjGet(NULL, options, iPtr->returnErrorlineKey, &value);
+ if (NULL == value) {
+ Tcl_DictObjPut(NULL, options, iPtr->returnErrorlineKey,
+ Tcl_NewIntObj(iPtr->errorLine));
+ }
+ }
+
+ if (NULL ==
+ Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, 0)) {
+ Tcl_DecrRefCount(options);
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "couldn't save return options in variable", -1);
+ return TCL_ERROR;
+ }
+ }
/*
* Set the interpreter's object result to an integer object holding the