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

        * generic/tclCmdAH.c ([catch], [error]):
        * generic/tclCmdMZ.c ([return]):
        * generic/tclProc.c (TclUpdateReturnInfo):
        * generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode
          TclTransferResult):   Refactored so that all errorCode setting
        flows through Tcl_SetObjErrorCode().  This greatly reduces the
        number of different places in the code that need to know details
        about an internal bitflag field of the Interp struct.  Also
        places errorCode setting in one place for easier future mods.

6 files changed, 41 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index 0125012..45380ae 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2004-09-17  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclBasic.c (Tcl_AddObjErrorInfo, Tcl_LogCommandInfo):
+	* generic/tclCmdAH.c ([catch], [error]):
+	* generic/tclCmdMZ.c ([return]):
+	* generic/tclProc.c (TclUpdateReturnInfo):
+	* generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode
+	  TclTransferResult): 	Refactored so that all errorCode setting
+	flows through Tcl_SetObjErrorCode().  This greatly reduces the
+	number of different places in the code that need to know details
+	about an internal bitflag field of the Interp struct.  Also
+	places errorCode setting in one place for easier future mods.
+
 2004-09-17  Kevin B.Kenny  <kennykb@acm.org>
 
 	* generic/tclDate.c:    Revised tclGetDate.y to use bison instead
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 83bc4a6..f6e5235 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.113 2004/09/08 17:04:01 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.114 2004/09/17 22:59:14 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3308,6 +3308,9 @@ Tcl_LogCommandInfo(interp, script, command, length)
     Tcl_AppendToObj(message, "\"", -1);
     TclAppendObjToErrorInfo(interp, message);
     Tcl_DecrRefCount(message);
+    if (!(iPtr->flags & ERROR_CODE_SET)) {
+	Tcl_SetErrorCode(interp, "NONE", NULL);
+    }
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
 }
 
@@ -4766,11 +4769,15 @@ Tcl_AddObjErrorInfo(interp, message, length)
 	/*
 	 * If the errorCode variable wasn't set by the code that generated
 	 * the error, set it to "NONE".
+	 *
+	 * NOTE: The main check for setting the default value of
+	 * errorCode to NONE is in Tcl_LogCommandInfo.  This one
+	 * should go away, but currently it's taking care of setting
+	 * up errorCode after compile errors.
 	 */
 
 	if (!(iPtr->flags & ERROR_CODE_SET)) {
-	    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, 
-	            Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY);
+	    Tcl_SetErrorCode(interp, "NONE", NULL);
 	}
     }
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 66ed491..9dbb644 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.45 2004/05/13 12:59:21 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.46 2004/09/17 22:59:14 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -299,16 +299,6 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
 	    }
 	}
 
-	if (iPtr->flags & ERROR_CODE_SET) {
-	    value = NULL;
-	    Tcl_DictObjGet(NULL, options, iPtr->returnErrorcodeKey, &value);
-	    if (NULL == value) {
-		Tcl_DictObjPut(NULL, options, iPtr->returnErrorcodeKey,
-			Tcl_ObjGetVar2(interp, iPtr->execEnvPtr->errorCode,
-			NULL, TCL_GLOBAL_ONLY));
-	    }
-	}
-
 	if (result == TCL_ERROR) {
 	    value = NULL;
 	    Tcl_DictObjGet(NULL, options, iPtr->returnErrorcodeKey, &value);
@@ -638,8 +628,7 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
     }
     
     if (objc == 4) {
-	Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
-	iPtr->flags |= ERROR_CODE_SET;
+	Tcl_SetObjErrorCode(interp, objv[3]);
     }
     
     Tcl_SetObjResult(interp, objv[1]);
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 235a9f9..9f41208 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.105 2004/08/30 18:06:33 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.106 2004/09/17 22:59:14 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -919,9 +919,7 @@ TclProcessReturn(interp, code, level, returnOpts)
 	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
 		    iPtr->returnErrorcodeKey, &valuePtr);
 	    if (valuePtr != NULL) {
-		Tcl_SetVar2Ex(interp, "errorCode", NULL,
-			valuePtr, TCL_GLOBAL_ONLY);
-		iPtr->flags |= ERROR_CODE_SET;
+		Tcl_SetObjErrorCode(interp, valuePtr);
 	    }
 	}
     } else {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 53e7633..3cd3af7 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.54 2004/08/25 01:11:20 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.55 2004/09/17 22:59:15 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1360,14 +1360,9 @@ TclUpdateReturnInfo(iPtr)
     if (code == TCL_ERROR) {
 	Tcl_DictObjGet(NULL, iPtr->returnOpts,
 		iPtr->returnErrorcodeKey, &valuePtr);
-	if (valuePtr == NULL) {
-	    Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
-	            NULL, Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY);
-	} else {
-	    Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
-	            NULL, valuePtr, TCL_GLOBAL_ONLY);
+	if (valuePtr != NULL) {
+	    Tcl_SetObjErrorCode((Tcl_Interp *)iPtr, valuePtr);
 	}
-	iPtr->flags |= ERROR_CODE_SET;
 
 	Tcl_DictObjGet(NULL, iPtr->returnOpts,
 		iPtr->returnErrorinfoKey, &valuePtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 7c4d696..c41b41b 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.8 2003/09/04 16:44:12 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.9 2004/09/17 22:59:15 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -876,26 +876,21 @@ Tcl_SetErrorCodeVA (interp, argList)
 				 * variable. */
     va_list argList;		/* Variable argument list. */
 {
-    char *string;
-    int flags;
-    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *errorObj = Tcl_NewObj();
 
     /*
      * Scan through the arguments one at a time, appending them to
      * $errorCode as list elements.
      */
 
-    flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
     while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
+	char *elem = va_arg(argList, char *);
+	if (elem == NULL) {
 	    break;
 	}
-	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
-		(char *) NULL, string, flags);
-	flags |= TCL_APPEND_VALUE;
+	Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
     }
-    iPtr->flags |= ERROR_CODE_SET;
+    Tcl_SetObjErrorCode(interp, errorObj);
 }
 
 /*
@@ -961,10 +956,10 @@ Tcl_SetObjErrorCode(interp, errorObjPtr)
     Tcl_Interp *interp;
     Tcl_Obj *errorObjPtr;
 {
-    Interp *iPtr;
+    Interp *iPtr = (Interp *) interp;
     
-    iPtr = (Interp *) interp;
-    Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);
+    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
+	    errorObjPtr, TCL_GLOBAL_ONLY);
     iPtr->flags |= ERROR_CODE_SET;
 }
 
@@ -1037,13 +1032,11 @@ TclTransferResult(sourceInterp, result, targetInterp)
 		TCL_GLOBAL_ONLY);
 	Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,
 		TCL_GLOBAL_ONLY);
+	((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS;
 
 	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
 		TCL_GLOBAL_ONLY);
-	Tcl_SetVar2Ex(targetInterp, "errorCode", NULL, objPtr,
-		TCL_GLOBAL_ONLY);
-
-	((Interp *) targetInterp)->flags |= (ERR_IN_PROGRESS | ERROR_CODE_SET);
+	Tcl_SetObjErrorCode(targetInterp, objPtr);
     }
 
     /* This may need examination for safety */