* generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified

        * tests/namespace.test (namespace-8.5,6):       the save/restore
        of ::errorInfo and ::errorCode during global namespace teardown.
        Revised the comment to clarify why this is done, and added tests
        that will fail if this is not done.

        * generic/tclResult.c (TclTransferResult):      Added safety
        checks so that unexpected undefined ::errorInfo or ::errorCode
        will not lead to a segfault.

        * generic/tclVar.c (CallVarTraces):     Save/restore the flag
        * tests/var.test (var-16.1):    values that define part of the
        interpreter state during variable traces.  [Bug 10381021].

3 files changed, 39 insertions, 40 deletions

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7e238d0..d319100 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.4 2004/09/10 18:22:09 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.5 2004/09/30 22:45:14 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -713,45 +713,37 @@ TclTeardownNamespace(nsPtr)
 
     if (nsPtr == globalNsPtr) {
 	/*
-	 * This is the global namespace, so be careful to preserve the
-	 * "errorInfo" and "errorCode" variables. These might be needed
-	 * later on if errors occur while deleting commands. We are careful
-	 * to destroy and recreate the "errorInfo" and "errorCode"
-	 * variables, in case they had any traces on them.
+	 * This is the global namespace.  Tearing it down will destroy the
+	 * ::errorInfo and ::errorCode variables.  We save and restore them
+	 * in case there are any errors in progress, so the error details
+	 * they contain will not be lost.  See test namespace-8.5
 	 */
     
-        CONST char *str;
-        char *errorInfoStr, *errorCodeStr;
+	Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo",
+		NULL, TCL_GLOBAL_ONLY);
+	Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode",
+		NULL, TCL_GLOBAL_ONLY);
 
-        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
-        if (str != NULL) {
-            errorInfoStr = ckalloc((unsigned) (strlen(str)+1));
-            strcpy(errorInfoStr, str);
-        } else {
-            errorInfoStr = NULL;
-        }
-
-        str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY);
-        if (str != NULL) {
-            errorCodeStr = ckalloc((unsigned) (strlen(str)+1));
-            strcpy(errorCodeStr, str);
-        } else {
-            errorCodeStr = NULL;
-        }
+	if (errorInfo) {
+	    Tcl_IncrRefCount(errorInfo);
+	}
+	if (errorCode) {
+	    Tcl_IncrRefCount(errorCode);
+	}
 
         TclDeleteVars(iPtr, &nsPtr->varTable);
         Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
 
-        if (errorInfoStr != NULL) {
-            Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr,
-                TCL_GLOBAL_ONLY);
-            ckfree(errorInfoStr);
-        }
-        if (errorCodeStr != NULL) {
-            Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr,
-                TCL_GLOBAL_ONLY);
-            ckfree(errorCodeStr);
-        }
+	if (errorInfo) {
+	    Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL,
+		    errorInfo, TCL_GLOBAL_ONLY);
+	    Tcl_DecrRefCount(errorInfo);
+	}
+	if (errorCode) {
+	    Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL,
+		    errorCode, TCL_GLOBAL_ONLY);
+	    Tcl_DecrRefCount(errorCode);
+	}
     } else {
 	/*
 	 * Variable table should be cleared but not freed! TclDeleteVars
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9cfbd63..badaf89 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.5.2.1 2003/07/16 21:25:07 hobbs Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.5.2.2 2004/09/30 22:45:15 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1029,15 +1029,18 @@ TclTransferResult(sourceInterp, result, targetInterp)
         
 	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL,
 		TCL_GLOBAL_ONLY);
-	Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,
-		TCL_GLOBAL_ONLY);
+	if (objPtr) {
+	    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);
+	if (objPtr) {
+	    Tcl_SetObjErrorCode(targetInterp, objPtr);
+	}
 
-	((Interp *) targetInterp)->flags |= (ERR_IN_PROGRESS | ERROR_CODE_SET);
     }
 
     ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 8478394..03b005e 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.69.2.6 2004/08/16 14:18:26 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.7 2004/09/30 22:45:15 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -4133,6 +4133,7 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
     int copiedName;
     int code = TCL_OK;
     int disposeFlags = 0;
+    int saveErrFlags = iPtr->flags;
 
     /*
      * If there are already similar trace procedures active for the
@@ -4255,6 +4256,9 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
      */
 
     done:
+    if (code == TCL_OK) {
+	iPtr->flags = saveErrFlags;
+    }
     if (code == TCL_ERROR) {
 	if (leaveErrMsg) {
 	    CONST char *type = "";