Tcl Source Code

Artifact f367f5af9db2b73382a2515ec048089d3de3816f:

Attachment "interpDeleted.patch" to ticket [495830ffff] added by msofer 2003-11-16 20:59:25.

---

Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.117
diff -u -r1.117 tclExecute.c
--- generic/tclExecute.c	16 Nov 2003 02:12:56 -0000	1.117
+++ generic/tclExecute.c	16 Nov 2003 13:57:39 -0000
@@ -1229,6 +1229,24 @@
 	}
     }
 
+    /* 
+     * Check for interpreter deletion [Bug 495830]. The only
+     * action allowed in a deleted interpreter is to return.
+     * Note that this is _almost_ correct; actually, invoking
+     * commands is forbidden in a deleted interpreter. 
+     */
+
+    if ((iPtr->flags & DELETED) && (*pc != INST_DONE)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "attempt to call eval in deleted interpreter", -1);
+	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+	        "attempt to call eval in deleted interpreter",
+		(char *) NULL);
+	result = TCL_ERROR;
+	goto abnormalReturn;
+    }
+
     switch (*pc) {
     case INST_RETURN:
 	if (iPtr->returnOpts != iPtr->defaultReturnOpts) {
Index: tests/interp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/interp.test,v
retrieving revision 1.25
diff -u -r1.25 interp.test
--- tests/interp.test	14 Nov 2003 20:44:46 -0000	1.25
+++ tests/interp.test	16 Nov 2003 13:57:39 -0000
@@ -641,6 +641,7 @@
     interp exists xxx
 } 0
 
+
 #
 # Alias loop prevention testing.
 #
@@ -759,7 +760,7 @@
 	list [catch {a eval foo} msg] $msg
     } {1 {attempt to call eval in deleted interpreter}}
 }
-test interp-18.9 {eval in deleted interp, bug 495830} {knownBug} {
+test interp-18.9 {eval in deleted interp, bug 495830} {
     interp create tst
     interp alias tst suicide {} interp delete tst
     list [catch {tst eval {suicide; set a 5}} msg] $msg
@@ -768,6 +769,16 @@
     interp create tst
     interp alias tst suicide {} interp delete tst
     list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
+} {1 {attempt to call eval in deleted interpreter}}     
+test interp-18.11 {eval in deleted interp, bug 495830} {
+    interp create tst
+    interp alias tst suicide {} interp delete tst
+    list [catch {tst eval {catch {suicide; $set a 5}}} msg] $msg
+} {1 {attempt to call eval in deleted interpreter}}     
+test interp-18.12 {eval in deleted interp, bug 495830} {
+    interp create tst
+    interp alias tst suicide {} interp delete tst
+    list [catch {tst eval {set catch catch set; catch {suicide; $set a 5}}} msg] $msg
 } {1 {attempt to call eval in deleted interpreter}}     
 
 # Test alias deletion