TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels

1 files changed, 45 insertions, 3 deletions

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index dbf6b2c..94bbb5c 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.60 2008/12/09 20:16:29 dgp Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.61 2008/12/18 01:14:16 ferrieux Exp $
  */
 
 #include "tclInt.h"
@@ -648,8 +648,8 @@ Tcl_CloseObjCmd(
 {
     Tcl_Channel chan;		/* The channel to close. */
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
 	return TCL_ERROR;
     }
 
@@ -657,6 +657,48 @@ Tcl_CloseObjCmd(
 	return TCL_ERROR;
     }
 
+    if (objc == 3) {
+	int optionIndex, dir;
+	static const char *const dirOptions[] = {
+	    "read", "write", NULL
+	};
+	static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+
+	/*
+	 * Get direction requested to close, and check syntax.
+	 */
+
+	if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
+		&optionIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	dir = dirArray[optionIndex];
+
+	/*
+	 * Check direction against channel mode. It is an error if we try to
+	 * close a direction not supported by the channel (already closed, or
+	 * never opened for that direction).
+	 */
+
+	if (!(dir & Tcl_GetChannelMode (chan))) {
+	    Tcl_AppendResult (interp, "Half-close of ", dirOptions[optionIndex],
+			      "-side not possible, side not opened or already closed",
+			      NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Special handling is needed if and only if the channel mode supports
+	 * more than the direction to close. Because if the close the last
+	 * direction suppported we can and will go through the regular
+	 * process.
+	 */
+
+	if ((Tcl_GetChannelMode (chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) {
+	    return Tcl_CloseEx (interp, chan, dir) != TCL_OK;
+	}
+    }
+
     if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
 	/*
 	 * If there is an error message and it ends with a newline, remove the