From cf5a2fcdb5b8dd834e530641922f7ba5c841553f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 14:18:35 +0000
Subject: We must Preserve channels if we're going to use
 TclChanCaughtErrorBypass() to get error information after channel routines
 are called (and have possibly called for the channel to go away).

---
 generic/tclIOCmd.c | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 7e8e91a..b206303 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -177,6 +177,7 @@ Tcl_PutsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_WriteObj(chan, string);
     if (result < 0) {
 	goto error;
@@ -187,6 +188,7 @@ Tcl_PutsObjCmd(
 	    goto error;
 	}
     }
+    Tcl_Release(chan);
     return TCL_OK;
 
     /*
@@ -202,6 +204,7 @@ Tcl_PutsObjCmd(
 		TclGetString(chanObjPtr), "\": ",
 		Tcl_PosixError(interp), NULL);
     }
+    Tcl_Release(chan);
     return TCL_ERROR;
 }
 
@@ -248,6 +251,7 @@ Tcl_FlushObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     if (Tcl_Flush(chan) != TCL_OK) {
 	/*
 	 * TIP #219.
@@ -261,8 +265,10 @@ Tcl_FlushObjCmd(
 		    TclGetString(chanObjPtr), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -295,6 +301,7 @@ Tcl_GetsObjCmd(
     int lineLen;		/* Length of line just read. */
     int mode;			/* Mode in which channel is opened. */
     Tcl_Obj *linePtr, *chanObjPtr;
+    int code = TCL_OK;
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -310,6 +317,7 @@ Tcl_GetsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     linePtr = Tcl_NewObj();
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen < 0) {
@@ -329,7 +337,8 @@ Tcl_GetsObjCmd(
 			TclGetString(chanObjPtr), "\": ",
 			Tcl_PosixError(interp), NULL);
 	    }
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
 	lineLen = -1;
     }
@@ -339,11 +348,12 @@ Tcl_GetsObjCmd(
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
-	return TCL_OK;
     } else {
 	Tcl_SetObjResult(interp, linePtr);
     }
-    return TCL_OK;
+  done:
+    Tcl_Release(chan);
+    return code;
 }
 
 /*
@@ -542,6 +552,7 @@ Tcl_SeekObjCmd(
 	mode = modeArray[optionIndex];
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
 	/*
@@ -555,8 +566,10 @@ Tcl_SeekObjCmd(
 		    TclGetString(objv[1]), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -587,6 +600,7 @@ Tcl_TellObjCmd(
 {
     Tcl_Channel chan;		/* The channel to tell on. */
     Tcl_WideInt newLoc;
+    int code;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -602,6 +616,7 @@ Tcl_TellObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     newLoc = Tcl_Tell(chan);
 
     /*
@@ -610,7 +625,10 @@ Tcl_TellObjCmd(
      * them into the regular interpreter result.
      */
 
-    if (TclChanCaughtErrorBypass(interp, chan)) {
+
+    code  = TclChanCaughtErrorBypass(interp, chan);
+    Tcl_Release(chan);
+    if (code) {
 	return TCL_ERROR;
     }
 
-- 
cgit v0.12