summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdMZ.c59
-rw-r--r--generic/tclProc.c16
3 files changed, 36 insertions, 45 deletions
diff --git a/ChangeLog b/ChangeLog
index 1d49934..acbfabe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;
}