summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-04-07 19:40:57 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-04-07 19:40:57 (GMT)
commita9077b7650915e4f0dd8c7788a7c455fa644db53 (patch)
tree9b47541206ea7e5f195bdaa0192f60e1f5670b19
parentb5dca8245923aea2ae9e88e04405563273143163 (diff)
downloadtcl-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--ChangeLog12
-rw-r--r--generic/tclIO.c12
-rw-r--r--tests/io.test3
3 files changed, 22 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 688ee7c..3e65b72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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}