TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels

1 files changed, 126 insertions, 1 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 12905de..3815c66 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.154 2008/12/11 17:30:18 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.155 2008/12/18 01:14:16 ferrieux Exp $
  */
 
 #include "tclInt.h"
@@ -3074,6 +3074,131 @@ Tcl_Close(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_CloseEx --
+ *
+ *	Half closes a channel.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Closes one direction of the channel.
+ *
+ * NOTE:
+ *	Tcl_CloseEx closes the specified direction of the channel as far as
+ *	the user is concerned. The channel keeps existing however. You cannot
+ *	calls this function to close the last possible direction of the
+ *	channel. Use Tcl_Close for that.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_CloseEx(
+    Tcl_Interp *interp,		/* Interpreter for errors. */
+    Tcl_Channel chan,		/* The channel being closed. May still be used by some interpreter */
+    int flags)                  /* Flags telling us which side to close. */
+{
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelState *statePtr;	/* State of real IO channel. */
+    int result;			/* Of calling FlushChannel. */
+
+    if (chan == NULL) {
+	return TCL_OK;
+    }
+
+    /* TODO: assert flags validity ? */
+
+    chanPtr = (Channel *) chan;
+    statePtr = chanPtr->state;
+
+    /*
+     * Does the channel support half-close anyway ? Error if not.
+     */
+
+    if (!chanPtr->typePtr->close2Proc) {
+	Tcl_AppendResult (interp, "Half-close of channels not supported by ",
+			  chanPtr->typePtr->typeName, "s", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Is the channel unstacked ? If not we fail.
+     */
+
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_AppendResult (interp,
+			  "Half-close not applicable to stack of transformations",
+			  NULL);
+	return TCL_ERROR;
+    }
+    
+    /*
+     * 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 (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
+	const char *msg;
+	if (flags & TCL_CLOSE_READ) {
+	    msg = "read";
+	} else {
+	    msg = "write";
+	}
+	Tcl_AppendResult (interp, "Half-close of ", msg,
+			      "-side not possible, side not opened or already closed",
+			      NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * A user may try to call half-close from within a channel close
+     * handler. That won't do.
+     */
+
+    if (statePtr->flags & CHANNEL_INCLOSE) {
+	if (interp) {
+	    Tcl_AppendResult(interp, "Illegal recursive call to close "
+		    "through close-handler of channel", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Finally do what is asked of us.
+     */
+
+    result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
+					  flags);
+
+    /*
+     * TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result.
+     */
+
+    if (TclChanCaughtErrorBypass(interp, chan)) {
+	result = EINVAL;
+    }
+
+    if (result != 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Remove the closed side from the channel mode/flags.
+     */
+
+    statePtr->flags &= ~(flags & (TCL_READABLE | TCL_WRITABLE));
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ClearChannelHandlers --
  *
  *	Removes all channel handlers and event scripts from the channel,