* 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.

2 files changed, 30 insertions, 45 deletions

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;
 }