* generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo):

        Shift the initialization of errorCode to NONE to more central
        location.

        * generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
        Rewrite to build on the new TclGet/SetReturnOptions routines.

        * generic/tclResult.c (TclGetReturnOptions): Add call to
        Tcl_AddObjErrorInfo to be sure error fields are initialized.

        * generic/tclResult.c (TclTransferResult):
        Rewrite to build on the new TclGet/SetReturnOptions routines.

3 files changed, 38 insertions, 78 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b37e20d..0102390 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.132 2004/10/21 17:07:31 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.133 2004/10/24 22:25:12 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3251,9 +3251,6 @@ Tcl_LogCommandInfo(interp, script, command, length)
     Tcl_AppendToObj(message, "\"", -1);
     TclAppendObjToErrorInfo(interp, message);
     Tcl_DecrRefCount(message);
-    if (!iPtr->errorCode) {
-	Tcl_SetErrorCode(interp, "NONE", NULL);
-    }
 }
 
 /*
@@ -4425,6 +4422,9 @@ Tcl_AddObjErrorInfo(interp, message, length)
 	    iPtr->errorInfo = iPtr->objResultPtr;
 	}
 	Tcl_IncrRefCount(iPtr->errorInfo);
+	if (!iPtr->errorCode) {
+	    Tcl_SetErrorCode(interp, "NONE", NULL);
+	}
     }
 
     /*
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 9eb195f..108ecf3 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEvent.c,v 1.49 2004/10/19 21:54:06 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.50 2004/10/24 22:25:12 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -27,8 +27,8 @@
 typedef struct BgError {
     Tcl_Obj *errorMsg;		/* Copy of the error message (the interp's
 				 * result when the error occurred). */
-    Tcl_Obj *errorInfo;		/* Value of the errorInfo variable */
-    Tcl_Obj *errorCode;		/* Value of the errorCode variable */
+    Tcl_Obj *returnOpts;	/* Active return options when the
+				 * error occurred */
     struct BgError *nextPtr;	/* Next in list of all pending error
 				 * reports for this interpreter, or NULL
 				 * for end of list. */
@@ -156,32 +156,12 @@ Tcl_BackgroundError(interp)
 {
     BgError *errPtr;
     ErrAssocData *assocPtr;
-    Interp *iPtr = (Interp *) interp;
 
     errPtr = (BgError *) ckalloc(sizeof(BgError));
     errPtr->errorMsg = Tcl_GetObjResult(interp);
     Tcl_IncrRefCount(errPtr->errorMsg);
-	    
-    /*
-     * The Tcl_AddErrorInfo call below (with an empty string) ensures that
-     * errorInfo gets properly set.  It's needed in cases where the error
-     * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
-     * in these cases errorInfo still won't have been set when this
-     * procedure is called.
-     */
-
-    Tcl_AddErrorInfo(interp, "");
-    errPtr->errorInfo = iPtr->errorInfo;
-    Tcl_IncrRefCount(errPtr->errorInfo);
-
-    if (iPtr->errorCode) {
-	errPtr->errorCode = iPtr->errorCode;
-    } else {
-	/* Does this ever happen ? */
-	errPtr->errorCode = Tcl_NewObj();
-    }
-    Tcl_IncrRefCount(errPtr->errorCode);
-
+    errPtr->returnOpts = TclGetReturnOptions(interp, TCL_ERROR);
+    Tcl_IncrRefCount(errPtr->returnOpts);
     errPtr->nextPtr = NULL;
 
     assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
@@ -251,7 +231,7 @@ HandleBgErrors(clientData)
     Tcl_Preserve((ClientData) interp);
     while (assocPtr->firstBgPtr != NULL) {
 	int code;
-	Interp *iPtr = (Interp *)interp;
+	Tcl_Obj *keyPtr, *valuePtr;
 	errPtr = assocPtr->firstBgPtr;
 
 	/*
@@ -263,10 +243,22 @@ HandleBgErrors(clientData)
 	 * anything we write to the interp fields.
 	 */
 
-	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
-		errPtr->errorInfo, TCL_GLOBAL_ONLY);
-	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
-		errPtr->errorCode, TCL_GLOBAL_ONLY);
+	keyPtr = Tcl_NewStringObj("-errorcode", -1);
+	Tcl_IncrRefCount(keyPtr);
+	Tcl_DictObjGet(NULL, errPtr->returnOpts, keyPtr, &valuePtr);
+	Tcl_DecrRefCount(keyPtr);
+	if (valuePtr) {
+	    Tcl_SetVar2Ex(interp, "errorCode", NULL,
+		    valuePtr, TCL_GLOBAL_ONLY);
+	}
+	keyPtr = Tcl_NewStringObj("-errorinfo", -1);
+	Tcl_IncrRefCount(keyPtr);
+	Tcl_DictObjGet(NULL, errPtr->returnOpts, keyPtr, &valuePtr);
+	Tcl_DecrRefCount(keyPtr);
+	if (valuePtr) {
+	    Tcl_SetVar2Ex(interp, "errorInfo", NULL,
+		    valuePtr, TCL_GLOBAL_ONLY);
+	}
 
 	/*
 	 * Create and invoke the bgerror command.
@@ -308,7 +300,9 @@ HandleBgErrors(clientData)
 		    Tcl_IncrRefCount(resultPtr);
 		    if (Tcl_FindCommand(interp, "bgerror",
 			    NULL, TCL_GLOBAL_ONLY) == NULL) {
-			Tcl_WriteObj(errChannel, errPtr->errorInfo);
+			if (valuePtr) {
+			    Tcl_WriteObj(errChannel, valuePtr);
+			}
 			Tcl_WriteChars(errChannel, "\n", -1);
                     } else {
 			Tcl_WriteChars(errChannel,
@@ -334,8 +328,7 @@ HandleBgErrors(clientData)
 
 	Tcl_DecrRefCount(objv[1]);
 	Tcl_DecrRefCount(errPtr->errorMsg);
-	Tcl_DecrRefCount(errPtr->errorInfo);
-	Tcl_DecrRefCount(errPtr->errorCode);
+	Tcl_DecrRefCount(errPtr->returnOpts);
 	assocPtr->firstBgPtr = errPtr->nextPtr;
 	ckfree((char *) errPtr);
 
@@ -354,8 +347,7 @@ HandleBgErrors(clientData)
 	errPtr = assocPtr->firstBgPtr;
 	assocPtr->firstBgPtr = errPtr->nextPtr;
 	Tcl_DecrRefCount(errPtr->errorMsg);
-	Tcl_DecrRefCount(errPtr->errorInfo);
-	Tcl_DecrRefCount(errPtr->errorCode);
+	Tcl_DecrRefCount(errPtr->returnOpts);
 	ckfree((char *) errPtr);
     }
 
@@ -398,8 +390,7 @@ BgErrorDeleteProc(clientData, interp)
 	errPtr = assocPtr->firstBgPtr;
 	assocPtr->firstBgPtr = errPtr->nextPtr;
 	Tcl_DecrRefCount(errPtr->errorMsg);
-	Tcl_DecrRefCount(errPtr->errorInfo);
-	Tcl_DecrRefCount(errPtr->errorCode);
+	Tcl_DecrRefCount(errPtr->returnOpts);
 	ckfree((char *) errPtr);
     }
     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 460ccaa..226af65 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclResult.c,v 1.19 2004/10/21 17:07:32 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.20 2004/10/24 22:25:13 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1410,6 +1410,7 @@ TclGetReturnOptions(interp, result)
 	 * When result was an error, fill in any missing values
 	 * for -errorinfo, -errorcode, and -errorline
 	 */
+        Tcl_AddObjErrorInfo(interp, "", -1);
 	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
 	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
 	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE],
@@ -1505,47 +1506,15 @@ TclTransferResult(sourceInterp, result, targetInterp)
 				 * should be stored.  If source and target
 				 * are the same, nothing is done. */
 {
-    Interp *siPtr = (Interp *) sourceInterp;
-    Interp *tiPtr = (Interp *) targetInterp;
+    Interp *iPtr = (Interp *) targetInterp;
 
     if (sourceInterp == targetInterp) {
 	return;
     }
 
-    if (result == TCL_ERROR) {
-	/*
-	 * An error occurred, so transfer error information from the source
-	 * interpreter to the target interpreter.  Setting the flags tells
-	 * the target interp that it has inherited a partial traceback
-	 * chain, not just a simple error message.
-	 */
-
-        if ((siPtr->flags & ERR_ALREADY_LOGGED) == 0) {
-            Tcl_AddErrorInfo(sourceInterp, "");
-        }
-        siPtr->flags &= ~(ERR_ALREADY_LOGGED);
-        
-        Tcl_ResetResult(targetInterp);
-        
-	if (siPtr->errorInfo) {
-	    tiPtr->errorInfo = siPtr->errorInfo;
-	    Tcl_IncrRefCount(tiPtr->errorInfo);
-	}
-
-	if (siPtr->errorCode) {
-	    Tcl_SetObjErrorCode(targetInterp, siPtr->errorCode);
-	}
-    }
-
-    /* This may need examination for safety */
-    if (tiPtr->returnOpts ) {
-	Tcl_DecrRefCount(tiPtr->returnOpts );
-    }
-    tiPtr->returnOpts = siPtr->returnOpts;
-    if (tiPtr->returnOpts ) {
-	Tcl_IncrRefCount(tiPtr->returnOpts );
-    }
-
+    TclSetReturnOptions(targetInterp,
+	    TclGetReturnOptions(sourceInterp, result));
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
     Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
     Tcl_ResetResult(sourceInterp);
 }