diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclIO.c | 265 | ||||
| -rw-r--r-- | generic/tclIO.h | 5 | ||||
| -rw-r--r-- | tests/chanio.test | 18 |
4 files changed, 274 insertions, 28 deletions
@@ -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 |