From d28769d37874fb207bec2ac0d3c8206c7ab566f8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 May 2014 13:19:30 +0000
Subject: Test iocmd-32.1 is not "impossible" but after writing it properly it
 does segfault trying to use a deleted interp.  Fixed.

---
 generic/tclIORChan.c | 12 +++++++++++-
 tests/ioCmd.test     |  9 ++++-----
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 7630473..3107f9e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -438,8 +438,8 @@ static const char *msg_write_nothing = "{write wrote nothing}";
 static const char *msg_seek_beforestart = "{Tried to seek before origin}";
 #ifdef TCL_THREADS
 static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost    = "{Owner lost}";
 #endif /* TCL_THREADS */
+static const char *msg_send_dstlost    = "{Owner lost}";
 static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
 
 /*
@@ -1302,6 +1302,7 @@ ReflectOutput(
     /* ASSERT: rcPtr->mode & TCL_WRITABLE */
 
     Tcl_Preserve(rcPtr);
+    Tcl_Preserve(rcPtr->interp);
 
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     Tcl_IncrRefCount(bufObj);
@@ -1318,6 +1319,14 @@ ReflectOutput(
         goto invalid;
     }
 
+    if (Tcl_InterpDeleted(rcPtr->interp)) {
+	/*
+	 * The interp was destroyed during InvokeTclMethod().
+	 */
+
+	SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+        goto invalid;
+    }
     if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
         goto invalid;
@@ -1347,6 +1356,7 @@ ReflectOutput(
  stop:
     Tcl_DecrRefCount(bufObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr->interp);
     Tcl_Release(rcPtr);
     return written;
  invalid:
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index bb133f9..5a76d48 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2038,13 +2038,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	proc foo {args} {
 	    oninit; onfinal; track;
 	    # destroy interpreter during channel access
-	    # Actually not possible for an interp to destroy itself.
-	    interp delete {}
-	    return}
+	    suicide
+	}
 	set chan [chan create {r w} foo]
 	fconfigure $chan -buffering none
 	set chan
     }]
+    interp alias $ida suicide {} interp delete $ida
 
     # Move channel to 2nd thread.
     interp eval $ida [list testchannel cut    $chan]
@@ -2063,8 +2063,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	set res
     }]
     set res
-} -constraints {testchannel impossible} \
-    -result {Owner lost}
+} -constraints {testchannel} -result {Owner lost}
 
 test iocmd-32.2 {delete interp of reflected chan} {
     # Bug 3034840
-- 
cgit v0.12