Tcl Source Code

Artifact 11d5ae37e82ddea8226280439100705976388a52:

Attachment "1649062.patch" to ticket [1649062fff] added by dgp 2007-06-06 00:33:23.

---

Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.245
diff -u -r1.245 tclBasic.c
--- generic/tclBasic.c	30 May 2007 18:12:57 -0000	1.245
+++ generic/tclBasic.c	5 Jun 2007 15:18:14 -0000
@@ -5227,6 +5227,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.311
diff -u -r1.311 tclInt.h
--- generic/tclInt.h	30 May 2007 18:12:58 -0000	1.311
+++ generic/tclInt.h	5 Jun 2007 15:18:15 -0000
@@ -1838,6 +1838,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.134
diff -u -r1.134 tclNamesp.c
--- generic/tclNamesp.c	7 May 2007 19:45:33 -0000	1.134
+++ generic/tclNamesp.c	5 Jun 2007 15:18:15 -0000
@@ -622,7 +622,7 @@
 {
     Interp *iPtr = (Interp *)interp;
 
-    if (Tcl_InterpDeleted(interp)) {
+    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
 	return NULL;
     }
     if (iPtr->errorCode) {
@@ -696,7 +696,7 @@
 {
     Interp *iPtr = (Interp *)interp;
 
-    if (Tcl_InterpDeleted(interp)) {
+    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
 	return NULL;
     }
     if (iPtr->errorInfo) {
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.115
diff -u -r1.115 tclProc.c
--- generic/tclProc.c	11 May 2007 09:17:01 -0000	1.115
+++ generic/tclProc.c	5 Jun 2007 15:18:16 -0000
@@ -2026,6 +2026,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.36
diff -u -r1.36 tclResult.c
--- generic/tclResult.c	20 Apr 2007 06:10:58 -0000	1.36
+++ generic/tclResult.c	5 Jun 2007 15:18:16 -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;
 }