summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-12-18 23:48:39 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-12-18 23:48:39 (GMT)
commit0f677b288fdee4290767e09fdf5b53c15cca5bef (patch)
tree57e2f1fd28e81a55bd9fbdfed4fee4cfa375d6a0
parent995eb54922eaaa97c8591d1368a1414bbf8aa22d (diff)
downloadtcl-0f677b288fdee4290767e09fdf5b53c15cca5bef.zip
tcl-0f677b288fdee4290767e09fdf5b53c15cca5bef.tar.gz
tcl-0f677b288fdee4290767e09fdf5b53c15cca5bef.tar.bz2
* generic/tclIO.c (Tcl_CloseEx,CloseWrite,CloseChannelPart,ChanCloseHalf):
Rewrite the half-close to properly flush the channel, like is done for a full close, going through FlushChannel, and using the flag BG_FLUSH_SCHEDULED (async flush during close). New functions CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE. * tests/chanio.test (chanio-28.[67]): Reactivated these tests. Replaced tclsh -> [interpreter] to get correct executable for the pipe process, and added after cancel to kill the fail timers when we are done. Removed the explicits calls to [flush], now that [close] handles this correctly.
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclIO.c265
-rw-r--r--generic/tclIO.h5
-rw-r--r--tests/chanio.test18
4 files changed, 274 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index 86fe926..b05976b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2008-12-18 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (Tcl_CloseEx,CloseWrite,CloseChannelPart,ChanCloseHalf):
+ Rewrite the half-close to properly flush the channel, like is done
+ for a full close, going through FlushChannel, and using the flag
+ BG_FLUSH_SCHEDULED (async flush during close). New functions
+ CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE.
+
+ * tests/chanio.test (chanio-28.[67]): Reactivated these
+ tests. Replaced tclsh -> [interpreter] to get correct executable
+ for the pipe process, and added after cancel to kill the fail
+ timers when we are done. Removed the explicits calls to [flush],
+ now that [close] handles this correctly.
+
2008-12-18 Don Porter <dgp@users.sourceforge.net>
* generic/tclExecute.c: Disabled apparently faulty assertion.
diff --git a/generic/tclIO.c b/generic/tclIO.c
index affa03b..b3df82e 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.156 2008/12/18 16:52:53 ferrieux Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.157 2008/12/18 23:48:39 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -62,6 +62,9 @@ static void CleanupChannelHandlers(Tcl_Interp *interp,
Channel *chanPtr);
static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
int errorCode);
+static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
+ int errorCode, int flags);
+static int CloseWrite(Tcl_Interp *interp, Channel* chanPtr);
static void CommonGetsCleanup(Channel *chanPtr);
static int CopyAndTranslateBuffer(ChannelState *statePtr,
char *result, int space);
@@ -258,6 +261,15 @@ ChanClose(
}
static inline int
+ChanCloseHalf(
+ Channel *chanPtr,
+ Tcl_Interp *interp,
+ int flags)
+{
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
+}
+
+static inline int
ChanRead(
Channel *chanPtr,
char *dst,
@@ -2518,6 +2530,19 @@ FlushChannel(
IsBufferEmpty(statePtr->curOutPtr))) {
return CloseChannel(interp, chanPtr, errorCode);
}
+
+ /*
+ * If the write-side of the channel is flagged as closed, delete it when
+ * the output queue is empty and there is no output in the current output
+ * buffer.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
+ (statePtr->outQueueHead == NULL) &&
+ ((statePtr->curOutPtr == NULL) ||
+ IsBufferEmpty(statePtr->curOutPtr))) {
+ return CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ }
return errorCode;
}
@@ -3076,7 +3101,7 @@ Tcl_Close(
*
* Tcl_CloseEx --
*
- * Half closes a channel.
+ * Closes one side of a channel, read or write.
*
* Results:
* A standard Tcl result.
@@ -3102,7 +3127,6 @@ Tcl_CloseEx(
{
Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of real IO channel. */
- int result; /* Of calling FlushChannel. */
if (chan == NULL) {
return TCL_OK;
@@ -3166,35 +3190,241 @@ Tcl_CloseEx(
return TCL_ERROR;
}
+ if (flags & TCL_CLOSE_READ) {
/*
- * Flush any data if [close w]
+ * Call the finalization code directly. There are no events to handle,
+ * there cannot be for the read-side.
*/
- if (flags & TCL_CLOSE_WRITE) {
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
+ return CloseChannelPart (interp, chanPtr, 0, flags);
+
+ } else if (flags & TCL_CLOSE_WRITE) {
+
+ if ((statePtr->curOutPtr != NULL) &&
+ IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
+ }
+ Tcl_Preserve(statePtr);
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ /*
+ * We don't want to re-enter CloseWrite().
+ */
+
+ if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) {
+ if (CloseWrite(interp, chanPtr) != TCL_OK) {
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ return TCL_ERROR;
}
- /*
- * Ignoring the outcome of the flush (like EPIPE), since we don't want
- * to disrupt the close path with such errors
- */
- FlushChannel(NULL, chanPtr, 0);
+ }
}
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseWrite --
+ *
+ * Closes the write side a channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes the write side of the channel.
+ *
+ * NOTE:
+ * CloseWrite removes the channel as far as the user is concerned.
+ * However, the ooutput data structures may continue to exist for a while
+ * longer if it has a background flush scheduled. The device itself is
+ * eventually closed and the channel structures modified, in
+ * CloseChannelPart, below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseWrite(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel* chanPtr) /* The channel whose write side is being closed. May still be used by some interpreter */
+{
+ /* Notes: clear-channel-handlers - write side only ? or keep around, just not caled */
+ /* No close cllbacks are run - channel is still open (read side) */
+
+ ChannelState *statePtr = chanPtr->state; /* State of real IO channel. */
+ int flushcode;
+ int result = 0;
+
+ /*
+ * Ensure that the last output buffer will be flushed.
+ */
+
+ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
+ }
/*
- * Finally do what is asked of us.
+ * The call to FlushChannel will flush any queued output and invoke the
+ * close function of the channel driver, or it will set up the channel to
+ * be flushed and closed asynchronously.
*/
- result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
- flags);
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+
+ flushcode = FlushChannel(interp, chanPtr, 0);
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result.
+ *
+ * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags
+ * FlushChannel() has called CloseChannelPart(). While we can still access
+ * "chan" (no structures were freed), the only place which may still
+ * contain a message is the interpreter itself, and "CloseChannelPart" made
+ * sure to lift any channel message it generated into it. Hence the NULL
+ * argument in the call below.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+ if (TclChanCaughtErrorBypass(interp, NULL)) {
+ result = EINVAL;
+ }
+
+ if ((flushcode != 0) || (result != 0)) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseChannelPart --
+ *
+ * Utility procedure to close a channel partially and free associated resources.
+ *
+ * If the channel was stacked it will never be run (The higher level forbid this).
+ *
+ * If the channel was not stacked, then we will free all the bits of the
+ * chosen side (read, or write) for the TOP channel.
+ *
+ * Results:
+ * Error code from an unreported error or the driver close2 operation.
+ *
+ * Side effects:
+ * May free memory, may change the value of errno.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseChannelPart(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel* chanPtr, /* The channel being closed. May still be used by some interpreter */
+ int errorCode, /* Status of operation so far. */
+ int flags) /* Flags telling us which side to close. */
+{
+ ChannelState *statePtr; /* State of real IO channel. */
+ int result; /* Of calling the close2proc. */
+
+ statePtr = chanPtr->state;
+
+ if (flags & TCL_CLOSE_READ) {
+ /*
+ * No more input can be consumed so discard any leftover input.
+ */
+
+ DiscardInputQueued(statePtr, 1);
+
+ } else if (flags & TCL_CLOSE_WRITE) {
+
+ /*
+ * The caller guarantees that there are no more buffers queued for
+ * output.
+ */
+
+ if (statePtr->outQueueHead != NULL) {
+ Tcl_Panic("ClosechanHalf, closed write-side of channel: queued output left");
+ }
+
+ /*
+ * If the EOF character is set in the channel, append that to the
+ * output device.
+ */
+
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
+ int dummy;
+ char c = (char) statePtr->outEofChar;
+
+ (void) ChanWrite(chanPtr, &c, 1, &dummy);
+ }
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move a leftover error message in the channel bypass into the
+ * interpreter bypass. Just clear it if there is no interpreter.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ if (interp != NULL) {
+ Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+ }
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ }
+
+ /*
+ * Finally do what is asked of us. Close and free the channel driver state
+ * for the chosen side of the channel. This may leave a TIP #219 error
+ * message in the interp.
+ */
+
+ result = ChanCloseHalf (chanPtr, interp, flags);
+
+ /*
+ * If we are being called synchronously, report either any latent error on
+ * the channel or the current error.
+ */
+
+ if (statePtr->unreportedError != 0) {
+ errorCode = statePtr->unreportedError;
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move an error message found in the unreported area into the regular
+ * bypass (interp). This kills any message in the channel bypass area.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ if (interp) {
+ Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+ }
+ }
+ if (errorCode == 0) {
+ errorCode = result;
+ if (errorCode != 0) {
+ Tcl_SetErrno(errorCode);
+ }
+ }
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result. See also the bottom of
+ * CloseWrite().
+ */
+
+ if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
result = EINVAL;
}
@@ -3206,8 +3436,7 @@ Tcl_CloseEx(
* Remove the closed side from the channel mode/flags.
*/
- statePtr->flags &= ~(flags & (TCL_READABLE | TCL_WRITABLE));
-
+ ResetFlag (statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
return TCL_OK;
}
diff --git a/generic/tclIO.h b/generic/tclIO.h
index a90817b..fa78769 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -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.h,v 1.14 2008/10/04 12:33:34 nijtmans Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.15 2008/12/18 23:48:39 andreas_kupries Exp $
*/
/*
@@ -339,6 +339,9 @@ typedef struct ChannelState {
* Used by Channel Tcl_Obj type to
* determine if we have to revalidate
* the channel. */
+#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed.
+ * No further Tcl-level write IO on
+ * the channel is allowed. */
/*
* For each channel handler registered in a call to Tcl_CreateChannelHandler,
diff --git a/tests/chanio.test b/tests/chanio.test
index 5ac00cb..0535bbd 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: chanio.test,v 1.18 2008/12/18 11:48:58 dkf Exp $
+# RCS: @(#) $Id: chanio.test,v 1.19 2008/12/18 23:48:39 andreas_kupries Exp $
if {[catch {package require tcltest 2}]} {
chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -2128,28 +2128,28 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} {stdio unix testchannel o
chan close $f
set l
} {file1 file2}
-test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} knownBug {
+test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} {
set cat [makeFile {
fconfigure stdout -buffering line
while {[gets stdin line]>=0} {puts $line}
puts DONE
exit 0
} cat.tcl]
- set ::ff [open "|[list tclsh $cat]" r+]
+ set ::ff [open "|[list [interpreter] $cat]" r+]
puts $::ff Hey
- flush $ff
close $::ff w
- after 1000 {set ::done Failed}
+ set timer [after 1000 {set ::done Failed}]
set ::acc {}
fileevent $::ff readable {
if {[gets $::ff line]<0} {set ::done Succeeded;return}
lappend ::acc $line
}
vwait ::done
+ after cancel $timer
close $::ff r
list $::done $::acc
} {Succeeded {Hey DONE}}
-test chan-io-28.7 {Tcl_CloseEx (half-close) socket} knownBug {
+test chan-io-28.7 {Tcl_CloseEx (half-close) socket} {
set echo [makeFile {
proc accept {s args} {set ::sok $s}
set s [socket -server accept 0]
@@ -2161,19 +2161,19 @@ test chan-io-28.7 {Tcl_CloseEx (half-close) socket} knownBug {
puts $::sok DONE
exit 0
} echo.tcl]
- set ::ff [open "|[list tclsh $echo]" r]
+ set ::ff [open "|[list [interpreter] $echo]" r]
gets $::ff port
set ::s [socket 127.0.0.1 $port]
puts $::s Hey
- flush $::s
close $::s w
- after 1000 {set ::done Failed}
+ set timer [after 1000 {set ::done Failed}]
set ::acc {}
fileevent $::s readable {
if {[gets $::s line]<0} {set ::done Succeeded;return}
lappend ::acc $line
}
vwait ::done
+ after cancel $timer
close $::s r
close $::ff
list $::done $::acc