From 7118dbc976774fdef3cc20ad168c22f23ed582f0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 15 Oct 2004 21:02:30 +0000
Subject:         * 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.

---
 ChangeLog          |  6 ++++++
 generic/tclCmdMZ.c | 59 +++++++++++++++++++++++++++---------------------------
 generic/tclProc.c  | 16 +--------------
 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;
 }
 
-- 
cgit v0.12