* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,

                TclEvalObjvInternal,Tcl_LogCommandInfo,TclAddObjErrorInfo):
        * generic/tclCmdAH.c (Tcl_CatchObjCmd):
        * generic/tclEvent.c (BgError,ErrAssocData,Tcl_BackgroundError,
                HandleBgErrors,BgErrorDeleteProc):
        * generic/tclExecute.c (TclCreateExecEnv,TclDeleteExecEnv):
        * generic/tclIOUtil.c (comments only):
        * generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS):
        * generic/tclInterp.c ([tclInit]):
        * generic/tclMain.c (comments only):
        * generic/tclNamesp.c
                (Tcl_CreateNamespace,Tcl_DeleteNamespace,TclTeardownNamespace):
        * generic/tclProc.c (TclUpdateReturnInfo):
        * generic/tclResult.c
                (Tcl_ResetResult,TclTransferResult):
        * generic/tclTrace.c (CallVarTraces):
        Reworked management of the "errorInfo" data of an interp.
        That information is now primarily stored in a new private
        (Tcl_Obj *) field of the Interp struct, rather than using a
        global variable ::errorInfo as the primary storage.  The
        ERR_IN_PROGRESS flag bit value is no longer required to manage
        the value in its new location, and is removed.  Variable traces
        are established to support compatibility for any code expecting
        the ::errorInfo variable to hold the information.

        ***POTENTIAL INCOMPATIBILITY***
        Code that sets traces on the ::errorInfo variable may notice a
        difference in timing of the firing of those traces.  Code that
        uses the value ERR_IN_PROGRESS.

1 files changed, 90 insertions, 99 deletions

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 5a38ad7..5ef1533 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.47 2004/10/05 18:14:27 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.48 2004/10/15 04:01:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -25,16 +25,10 @@
  */
 
 typedef struct BgError {
-    Tcl_Interp *interp;		/* Interpreter in which error occurred.  NULL
-				 * means this error report has been cancelled
-				 * (a previous report generated a break). */
-    char *errorMsg;		/* Copy of the error message (the interp's
-				 * result when the error occurred).
-				 * Malloc-ed. */
-    char *errorInfo;		/* Value of the errorInfo variable
-				 * (malloc-ed). */
-    Tcl_Obj *errorCode;		/* Value of the errorCode variable
-				 * (malloc-ed). */
+    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 */
     struct BgError *nextPtr;	/* Next in list of all pending error
 				 * reports for this interpreter, or NULL
 				 * for end of list. */
@@ -47,6 +41,7 @@ typedef struct BgError {
  */
 
 typedef struct ErrAssocData {
+    Tcl_Interp *interp;		/* Interpreter in which error occurred. */
     BgError *firstBgPtr;	/* First in list of all background errors
 				 * waiting to be processed for this
 				 * interpreter (NULL if none). */
@@ -160,11 +155,13 @@ Tcl_BackgroundError(interp)
 				 * occurred. */
 {
     BgError *errPtr;
-    CONST char *errResult, *varValue;
     ErrAssocData *assocPtr;
-    int length;
     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
@@ -174,19 +171,8 @@ Tcl_BackgroundError(interp)
      */
 
     Tcl_AddErrorInfo(interp, "");
-
-    errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
-	
-    errPtr = (BgError *) ckalloc(sizeof(BgError));
-    errPtr->interp = interp;
-    errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
-    memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
-    varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
-    if (varValue == NULL) {
-	varValue = errPtr->errorMsg;
-    }
-    errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
-    strcpy(errPtr->errorInfo, varValue);
+    errPtr->errorInfo = iPtr->errorInfo;
+    Tcl_IncrRefCount(errPtr->errorInfo);
 
     if (iPtr->errorCode) {
 	errPtr->errorCode = iPtr->errorCode;
@@ -209,6 +195,7 @@ Tcl_BackgroundError(interp)
 	 */
 
 	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+	assocPtr->interp = interp;
 	assocPtr->firstBgPtr = NULL;
 	assocPtr->lastBgPtr = NULL;
 	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
@@ -245,43 +232,50 @@ static void
 HandleBgErrors(clientData)
     ClientData clientData;	/* Pointer to ErrAssocData structure. */
 {
-    Tcl_Interp *interp;
-    int code;
-    BgError *errPtr;
     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
-    Tcl_Channel errChannel;
+    Tcl_Interp *interp = assocPtr->interp;
+    BgError *errPtr;
     Tcl_Obj *objv[2];
 
+    /*
+     * Not bothering to save/restore the interp state.  Assume that
+     * any code that has interp state it needs to keep will make
+     * its own Tcl_SaveResult call before calling something like
+     * Tcl_DoOneEvent() that could lead us here.
+     */
+
     objv[0] = Tcl_NewStringObj("bgerror", -1);
     Tcl_IncrRefCount(objv[0]);
-    objv[1] = NULL;
 
     Tcl_Preserve((ClientData) assocPtr);
+    Tcl_Preserve((ClientData) interp);
     while (assocPtr->firstBgPtr != NULL) {
-	interp = assocPtr->firstBgPtr->interp;
-	if (interp == NULL) {
-	    goto doneWithInterp;
-	}
+	int code;
+	Interp *iPtr = (Interp *)interp;
+	errPtr = assocPtr->firstBgPtr;
 
 	/*
 	 * Restore important state variables to what they were at
 	 * the time the error occurred.
+	 *
+	 * Need to set the variables, not the interp fields, because
+	 * Tcl_EvalObjv() calls Tcl_ResetResult() which would destroy
+	 * anything we write to the interp fields.
 	 */
 
-	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
-		TCL_GLOBAL_ONLY);
-	Tcl_SetVar2Ex(interp, "errorCode", NULL,
-		assocPtr->firstBgPtr->errorCode, TCL_GLOBAL_ONLY);
+	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		errPtr->errorInfo, TCL_GLOBAL_ONLY);
+	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+		errPtr->errorCode, TCL_GLOBAL_ONLY);
 
 	/*
 	 * Create and invoke the bgerror command.
 	 */
 
-	objv[1] = Tcl_NewStringObj(assocPtr->firstBgPtr->errorMsg, -1);
+	objv[1] = errPtr->errorMsg;
 	Tcl_IncrRefCount(objv[1]);
 	
 	Tcl_AllowExceptions(interp);
-        Tcl_Preserve((ClientData) interp);
 	code = Tcl_EvalObjv(interp, 2, objv, TCL_EVAL_GLOBAL);
 	if (code == TCL_ERROR) {
 
@@ -302,49 +296,37 @@ HandleBgErrors(clientData)
 		Tcl_SaveResult(interp, &save);
                 TclObjInvoke(interp, 2, objv, TCL_INVOKE_HIDDEN);
 		Tcl_RestoreResult(interp, &save);
+            } else {
 
-                goto doneWithInterp;
-            } 
-
-            /*
-             * We have to get the error output channel at the latest possible
-             * time, because the eval (above) might have changed the channel.
-             */
+		/*
+		 * We have to get the error output channel at the latest
+		 * possible time, because the eval (above) might have
+		 * changed the channel.
+		 */
             
-            errChannel = Tcl_GetStdChannel(TCL_STDERR);
-            if (errChannel != (Tcl_Channel) NULL) {
-		char *string;
-		int len;
-
-		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
-		if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
-                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                } else {
-                    Tcl_WriteChars(errChannel,
-                            "bgerror failed to handle background error.\n",
-                            -1);
-                    Tcl_WriteChars(errChannel, "    Original error: ", -1);
-                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
-                            -1);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
-                    Tcl_WriteChars(errChannel, string, len);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                }
-                Tcl_Flush(errChannel);
-            }
-	} else if (code == TCL_BREAK) {
-
-	    /*
-	     * Break means cancel any remaining error reports for this
-	     * interpreter.
-	     */
-
-	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
-		    errPtr = errPtr->nextPtr) {
-		if (errPtr->interp == interp) {
-		    errPtr->interp = NULL;
+		Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		if (errChannel != (Tcl_Channel) NULL) {
+		    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+		    Tcl_IncrRefCount(resultPtr);
+		    if (Tcl_FindCommand(interp, "bgerror",
+			    NULL, TCL_GLOBAL_ONLY) == NULL) {
+			Tcl_WriteObj(errChannel, errPtr->errorInfo);
+			Tcl_WriteChars(errChannel, "\n", -1);
+                    } else {
+			Tcl_WriteChars(errChannel,
+				"bgerror failed to handle background error.\n",
+				-1);
+			Tcl_WriteChars(errChannel, "    Original error: ", -1);
+			Tcl_WriteObj(errChannel, errPtr->errorMsg);
+			Tcl_WriteChars(errChannel, "\n", -1);
+			Tcl_WriteChars(errChannel,
+				"    Error in bgerror: ", -1);
+			Tcl_WriteObj(errChannel, resultPtr);
+			Tcl_WriteChars(errChannel, "\n", -1);
+                    }
+		    Tcl_DecrRefCount(resultPtr);
+                    Tcl_Flush(errChannel);
 		}
 	    }
 	}
@@ -353,28 +335,37 @@ HandleBgErrors(clientData)
 	 * Discard the command and the information about the error report.
 	 */
 
-doneWithInterp:
-	if (objv[1]) {
-	    Tcl_DecrRefCount(objv[1]);
-	    objv[1] = NULL;
-	}
+	Tcl_DecrRefCount(objv[1]);
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->errorInfo);
+	Tcl_DecrRefCount(errPtr->errorCode);
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	ckfree((char *) errPtr);
 
-	if (assocPtr->firstBgPtr) {
-	    ckfree(assocPtr->firstBgPtr->errorMsg);
-	    ckfree(assocPtr->firstBgPtr->errorInfo);
-	    Tcl_DecrRefCount(assocPtr->firstBgPtr->errorCode);
-	    errPtr = assocPtr->firstBgPtr->nextPtr;
-	    ckfree((char *) assocPtr->firstBgPtr);
-	    assocPtr->firstBgPtr = errPtr;
+	if (code == TCL_BREAK) {
+	    /*
+	     * Break means cancel any remaining error reports for this
+	     * interpreter.
+	     */
+	    break;
 	}
         
-        if (interp != NULL) {
-            Tcl_Release((ClientData) interp);
-        }
     }
+
+    /* Cleanup any error reports we didn't do (due to a TCL_BREAK) */
+    while (assocPtr->firstBgPtr != NULL) {
+	errPtr = assocPtr->firstBgPtr;
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->errorInfo);
+	Tcl_DecrRefCount(errPtr->errorCode);
+	ckfree((char *) errPtr);
+    }
+
     assocPtr->lastBgPtr = NULL;
     Tcl_DecrRefCount(objv[0]);
 
+    Tcl_Release((ClientData) interp);
     Tcl_Release((ClientData) assocPtr);
 }
 
@@ -409,8 +400,8 @@ BgErrorDeleteProc(clientData, interp)
     while (assocPtr->firstBgPtr != NULL) {
 	errPtr = assocPtr->firstBgPtr;
 	assocPtr->firstBgPtr = errPtr->nextPtr;
-	ckfree(errPtr->errorMsg);
-	ckfree(errPtr->errorInfo);
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->errorInfo);
 	Tcl_DecrRefCount(errPtr->errorCode);
 	ckfree((char *) errPtr);
     }