diff options
author | andreas_kupries <akupries@shaw.ca> | 2008-04-07 19:40:57 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2008-04-07 19:40:57 (GMT) |
commit | a9077b7650915e4f0dd8c7788a7c455fa644db53 (patch) | |
tree | 9b47541206ea7e5f195bdaa0192f60e1f5670b19 | |
parent | b5dca8245923aea2ae9e88e04405563273143163 (diff) | |
download | tcl-a9077b7650915e4f0dd8c7788a7c455fa644db53.zip tcl-a9077b7650915e4f0dd8c7788a7c455fa644db53.tar.gz tcl-a9077b7650915e4f0dd8c7788a7c455fa644db53.tar.bz2 |
* generic/tclIO.c (BUSY_STATE, CheckChannelErrors,
TclCopyChannel): New macro, and the places using it. This change
allows for bi-directional fcopy on channels. Thanks to Alexandre
Ferrieux <ferrieux@users.sourceforge.net> for the patch.
* tests/io.test (io-53.9): Made test cleanup robust against the
possibility of slow process shutdown on Windows. Backported from
Kevin Kenny's change to the same test on the 8.5 and head
branches.
-rw-r--r-- | ChangeLog | 12 | ||||
-rw-r--r-- | generic/tclIO.c | 12 | ||||
-rw-r--r-- | tests/io.test | 3 |
3 files changed, 22 insertions, 5 deletions
@@ -1,3 +1,15 @@ +2008-04-07 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (BUSY_STATE, CheckChannelErrors, + TclCopyChannel): New macro, and the places using it. This change + allows for bi-directional fcopy on channels. Thanks to Alexandre + Ferrieux <ferrieux@users.sourceforge.net> for the patch. + + * tests/io.test (io-53.9): Made test cleanup robust against the + possibility of slow process shutdown on Windows. Backported from + Kevin Kenny's change to the same test on the 8.5 and head + branches. + 2008-04-04 Andreas Kupries <andreask@activestate.com> * tests/io.test (io-53.9): Added testcase for [Bug 780533], based diff --git a/generic/tclIO.c b/generic/tclIO.c index aba2735..739b644 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.61.2.25 2008/04/03 18:06:52 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.61.2.26 2008/04/07 19:40:58 andreas_kupries Exp $ */ #include "tclInt.h" @@ -156,6 +156,10 @@ static int WriteBytes _ANSI_ARGS_((Channel *chanPtr, static int WriteChars _ANSI_ARGS_((Channel *chanPtr, CONST char *src, int srcLen)); +#define BUSY_STATE(st,fl) \ + ((st)->csPtr && \ + ( (((fl)&TCL_READABLE)&&((st)->csPtr->readPtr ==(st)->topChanPtr)) || \ + (((fl)&TCL_WRITABLE)&&((st)->csPtr->writePtr==(st)->topChanPtr)))) /* *--------------------------------------------------------------------------- @@ -5914,7 +5918,7 @@ CheckChannelErrors(statePtr, flags) * retrieving and transforming the data to copy. */ - if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) { + if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) { Tcl_SetErrno(EBUSY); return -1; } @@ -7681,14 +7685,14 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr) inStatePtr = inPtr->state; outStatePtr = outPtr->state; - if (inStatePtr->csPtr) { + if (BUSY_STATE(inStatePtr,TCL_READABLE)) { if (interp) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(inChan), "\" is busy", NULL); } return TCL_ERROR; } - if (outStatePtr->csPtr) { + if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) { if (interp) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(outChan), "\" is busy", NULL); diff --git a/tests/io.test b/tests/io.test index 24e6580..696366b 100644 --- a/tests/io.test +++ b/tests/io.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: io.test,v 1.40.2.14 2008/04/04 20:01:00 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.40.2.15 2008/04/07 19:41:00 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -7008,6 +7008,7 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { } -cleanup { close $pipe rename ::done {} + after 1000 ;# Give Windows time to kill the process removeFile out removeFile err catch {unset ::forever} |