Tcl Source Code

Artifact a42a6982e2adb9e16b319eee2a819ba875a28bd6:

Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.234
diff -u -r1.234 tclBasic.c
--- generic/tclBasic.c	14 Dec 2006 16:08:22 -0000	1.234
+++ generic/tclBasic.c	31 Jan 2007 19:09:35 -0000
@@ -5327,6 +5327,7 @@
      * the error message in the interpreter's result.
      */
 
+    iPtr->flags |= ERR_LEGACY_COPY;
     if (iPtr->errorInfo == NULL) {
 	if (iPtr->result[0] != 0) {
 	    /*
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.300
diff -u -r1.300 tclInt.h
--- generic/tclInt.h	1 Dec 2006 15:55:45 -0000	1.300
+++ generic/tclInt.h	31 Jan 2007 19:09:35 -0000
@@ -1813,6 +1813,7 @@
 #define SAFE_INTERP			 0x80
 #define INTERP_TRACE_IN_PROGRESS	0x200
 #define INTERP_ALTERNATE_WRONG_ARGS	0x400
+#define ERR_LEGACY_COPY			0x800
 
 /*
  * Maximum number of levels of nesting permitted in Tcl commands (used to
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.121
diff -u -r1.121 tclNamesp.c
--- generic/tclNamesp.c	8 Dec 2006 13:50:42 -0000	1.121
+++ generic/tclNamesp.c	31 Jan 2007 19:09:36 -0000
@@ -621,7 +621,8 @@
 {
     Interp *iPtr = (Interp *)interp;
 
-    if (flags & TCL_INTERP_DESTROYED || iPtr->errorCode == NULL) {
+    if (flags & TCL_INTERP_DESTROYED || iPtr->errorCode == NULL
+	    || !(iPtr->flags & ERR_LEGACY_COPY)) {
 	return NULL;
     }
     Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode,
@@ -688,7 +689,8 @@
 {
     Interp *iPtr = (Interp *)interp;
 
-    if (flags & TCL_INTERP_DESTROYED || iPtr->errorInfo == NULL) {
+    if (flags & TCL_INTERP_DESTROYED || iPtr->errorInfo == NULL
+	    || !(iPtr->flags & ERR_LEGACY_COPY)) {
 	return NULL;
     }
     Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.108
diff -u -r1.108 tclProc.c
--- generic/tclProc.c	28 Nov 2006 22:20:29 -0000	1.108
+++ generic/tclProc.c	31 Jan 2007 19:09:36 -0000
@@ -1966,6 +1966,9 @@
 	 */
 
 	code = iPtr->returnCode;
+	if (code == TCL_ERROR) {
+	    iPtr->flags |= ERR_LEGACY_COPY;
+	}
     }
     return code;
 }
Index: generic/tclResult.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResult.c,v
retrieving revision 1.33
diff -u -r1.33 tclResult.c
--- generic/tclResult.c	29 Jan 2007 18:55:50 -0000	1.33
+++ generic/tclResult.c	31 Jan 2007 19:09:36 -0000
@@ -906,15 +906,19 @@
     iPtr->resultSpace[0] = 0;
     if (iPtr->errorCode) {
 	/* Legacy support */
-	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
-		iPtr->errorCode, TCL_GLOBAL_ONLY);
+	if (iPtr->flags & ERR_LEGACY_COPY) {
+	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+		    iPtr->errorCode, TCL_GLOBAL_ONLY);
+	}
 	Tcl_DecrRefCount(iPtr->errorCode);
 	iPtr->errorCode = NULL;
     }
     if (iPtr->errorInfo) {
 	/* Legacy support */
-	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
-		iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	if (iPtr->flags & ERR_LEGACY_COPY) {
+	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	}
 	Tcl_DecrRefCount(iPtr->errorInfo);
 	iPtr->errorInfo = NULL;
     }
@@ -924,7 +928,7 @@
 	Tcl_DecrRefCount(iPtr->returnOpts);
 	iPtr->returnOpts = NULL;
     }
-    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY);
 }
 
 /*
@@ -1237,6 +1241,9 @@
 	iPtr->returnCode = code;
 	return TCL_RETURN;
     }
+    if (code == TCL_ERROR) {
+	iPtr->flags |= ERR_LEGACY_COPY;
+    }
     return code;
 }