summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-04-07 22:33:28 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-04-07 22:33:28 (GMT)
commit58cdf9a29789c2ea52ed2b5999be5638c6213498 (patch)
treee61211e2c080e1862486b21be12ec7a79436dcb8
parent9315133c1a940e86af372bcefd446933743882e3 (diff)
downloadtcl-58cdf9a29789c2ea52ed2b5999be5638c6213498.zip
tcl-58cdf9a29789c2ea52ed2b5999be5638c6213498.tar.gz
tcl-58cdf9a29789c2ea52ed2b5999be5638c6213498.tar.bz2
* tests/io.test (io-53.10): Testcase for bi-directionaly fcopy.
* tests/chanio.test: * generic/tclIO.c: Additional changes to data structures for fcopy * generic/tclIO.h: and channels to perform proper cleanup in case of a channel having two background copy operations running as is now possible.
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclIO.c66
-rw-r--r--generic/tclIO.h5
-rw-r--r--tests/chanio.test72
-rw-r--r--tests/io.test72
5 files changed, 199 insertions, 31 deletions
diff --git a/ChangeLog b/ChangeLog
index 399ce04..f557550 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
2008-04-07 Andreas Kupries <andreask@activestate.com>
+ * tests/io.test (io-53.10): Testcase for bi-directionaly fcopy.
+ * tests/chanio.test:
+ * generic/tclIO.c: Additional changes to data structures for fcopy
+ * generic/tclIO.h: and channels to perform proper cleanup in case
+ of a channel having two background copy operations running as is
+ now possible.
+
+ * tests/io.test (io-53.10): Testcase for bi-directionaly fcopy.
+ * generic/tclIO.c: Additional changes to data structures for fcopy
+ and channels to perform proper cleanup in case of a channel
+ having two background copy operations running as is now
+ possible.
+
+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. [Bug 1350564].
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 783011f..77d586c 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.137.2.3 2008/04/07 19:42:03 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.137.2.4 2008/04/07 22:33:29 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -222,9 +222,8 @@ static Tcl_ObjType tclChannelType = {
((objPtr)->internalRep.otherValuePtr = (void *) (storePtr))
#define BUSY_STATE(st,fl) \
- ((st)->csPtr && \
- ( (((fl)&TCL_READABLE)&&((st)->csPtr->readPtr ==(st)->topChanPtr)) || \
- (((fl)&TCL_WRITABLE)&&((st)->csPtr->writePtr==(st)->topChanPtr))))
+ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
+ (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
/*
*---------------------------------------------------------------------------
@@ -1317,7 +1316,8 @@ Tcl_CreateChannel(
statePtr->scriptRecordPtr = NULL;
statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
statePtr->timer = NULL;
- statePtr->csPtr = NULL;
+ statePtr->csPtrR = NULL;
+ statePtr->csPtrW = NULL;
statePtr->outputStage = NULL;
if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
@@ -1478,13 +1478,18 @@ Tcl_StackChannel(
*/
if ((mask & TCL_WRITABLE) != 0) {
- CopyState *csPtr;
+ CopyState *csPtrR;
+ CopyState *csPtrW;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = NULL;
+ csPtrR = statePtr->csPtrR;
+ statePtr->csPtrR = NULL;
+
+ csPtrW = statePtr->csPtrW;
+ statePtr->csPtrW = NULL;
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
if (interp) {
Tcl_AppendResult(interp, "could not flush channel \"",
Tcl_GetChannelName(prevChan), "\"", NULL);
@@ -1492,7 +1497,8 @@ Tcl_StackChannel(
return NULL;
}
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
}
/*
@@ -1624,13 +1630,18 @@ Tcl_UnstackChannel(
*/
if (statePtr->flags & TCL_WRITABLE) {
- CopyState *csPtr;
+ CopyState *csPtrR;
+ CopyState *csPtrW;
+
+ csPtrR = statePtr->csPtrR;
+ statePtr->csPtrR = NULL;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = NULL;
+ csPtrW = statePtr->csPtrW;
+ statePtr->csPtrW = NULL;
if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
/*
* TIP #219, Tcl Channel Reflection API.
@@ -1648,7 +1659,8 @@ Tcl_UnstackChannel(
return TCL_ERROR;
}
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
}
/*
@@ -3091,7 +3103,8 @@ Tcl_ClearChannelHandlers(
* Cancel any pending copy operation.
*/
- StopCopy(statePtr->csPtr);
+ StopCopy(statePtr->csPtrR);
+ StopCopy(statePtr->csPtrW);
/*
* Must set the interest mask now to 0, otherwise infinite loops
@@ -7096,12 +7109,10 @@ Tcl_GetChannelOption(
* If we are in the middle of a background copy, use the saved flags.
*/
- if (statePtr->csPtr) {
- if (chanPtr == statePtr->csPtr->readPtr) {
- flags = statePtr->csPtr->readFlags;
- } else {
- flags = statePtr->csPtr->writeFlags;
- }
+ if (statePtr->csPtrR) {
+ flags = statePtr->csPtrR->readFlags;
+ } else if (statePtr->csPtrW) {
+ flags = statePtr->csPtrW->writeFlags;
} else {
flags = statePtr->flags;
}
@@ -7311,7 +7322,7 @@ Tcl_SetChannelOption(
* If the channel is in the middle of a background copy, fail.
*/
- if (statePtr->csPtr) {
+ if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
Tcl_AppendResult(interp, "unable to set channel options: "
"background copy in progress", NULL);
@@ -8498,8 +8509,9 @@ TclCopyChannel(
Tcl_IncrRefCount(cmdPtr);
}
csPtr->cmdPtr = cmdPtr;
- inStatePtr->csPtr = csPtr;
- outStatePtr->csPtr = csPtr;
+
+ inStatePtr->csPtrR = csPtr;
+ outStatePtr->csPtrW = csPtr;
/*
* Start copying data between the channels.
@@ -9451,8 +9463,8 @@ StopCopy(
}
TclDecrRefCount(csPtr->cmdPtr);
}
- inStatePtr->csPtr = NULL;
- outStatePtr->csPtr = NULL;
+ inStatePtr->csPtrR = NULL;
+ outStatePtr->csPtrW = NULL;
ckfree((char *) csPtr);
}
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 411f48d..eab83eb 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.11 2007/12/13 15:23:18 dgp Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.11.2.1 2008/04/07 22:33:30 andreas_kupries Exp $
*/
/*
@@ -219,7 +219,8 @@ typedef struct ChannelState {
* handlers ("fileevent") on this channel. */
int bufSize; /* What size buffers to allocate? */
Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
- CopyState *csPtr; /* State of background copy, or NULL. */
+ CopyState *csPtrR; /* State of background copy for which channel is input, or NULL. */
+ CopyState *csPtrW; /* State of background copy for which channel is output, or NULL. */
Channel *topChanPtr; /* Refers to topmost channel in a stack. Never
* NULL. */
Channel *bottomChanPtr; /* Refers to bottommost channel in a stack.
diff --git a/tests/chanio.test b/tests/chanio.test
index d44902d..7580d30 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.3.2.3 2008/04/06 00:52:09 kennykb Exp $
+# RCS: @(#) $Id: chanio.test,v 1.3.2.4 2008/04/07 22:33:30 andreas_kupries Exp $
if {[catch {package require tcltest 2}]} {
chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -6982,6 +6982,76 @@ test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
catch {removeFile err}
catch {unset ::forever}
} -result OK
+test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+ set err [makeFile {} err]
+ set pipe [open "|[info nameofexecutable] 2> $err" r+]
+ chan configure $pipe -translation binary -buffering line
+ chan puts $pipe {
+ chan configure stderr -buffering line
+ # Kill server when pipe closed by invoker.
+ proc bye args {
+ if {![chan eof stdin]} { chan gets stdin ; return }
+ chan puts stderr BYE
+ exit
+ }
+ # Server code. Bi-directional copy between 2 sockets.
+ proc geof {sok} {
+ chan puts stderr DONE/$sok
+ chan close $sok
+ }
+ proc new {sok args} {
+ chan puts stderr NEW/$sok
+ global l srv
+ chan configure $sok -translation binary -buffering none
+ lappend l $sok
+ if {[llength $l]==2} {
+ chan close $srv
+ foreach {a b} $l break
+ chan copy $a $b -command [list geof $a]
+ chan copy $b $a -command [list geof $b]
+ chan puts stderr 2COPY
+ }
+ chan puts stderr ...
+ }
+ chan puts stderr SRV
+ set l {}
+ set srv [socket -server new 9999]
+ chan puts stderr WAITING
+ chan event stdin readable bye
+ chan puts OK
+ vwait forever
+ }
+ # wait for OK from server.
+ chan gets $pipe
+ # Now the two clients.
+ proc ::done {sock} {
+ if {[chan eof $sock]} { chan close $sock ; return }
+ lappend ::forever [chan gets $sock]
+ return
+ }
+ set a [socket 127.0.0.1 9999]
+ set b [socket 127.0.0.1 9999]
+ chan configure $a -translation binary -buffering none
+ chan configure $b -translation binary -buffering none
+ chan event $a readable [list ::done $a]
+ chan event $b readable [list ::done $b]
+} -constraints {stdio openpipe fcopy} -body {
+ # Now pass data through the server in both directions.
+ set ::forever {}
+ chan puts $a AB
+ vwait ::forever
+ chan puts $b BA
+ vwait ::forever
+ set ::forever
+} -cleanup {
+ catch {chan close $a}
+ catch {chan close $b}
+ chan close $pipe
+ rename ::done {}
+ after 1000 ;# Give Windows time to kill the process
+ removeFile err
+ catch {unset ::forever}
+} -result {AB BA}
test chan-io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive
diff --git a/tests/io.test b/tests/io.test
index 27ccdbd..4b495fa 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.80.2.3 2008/04/06 00:52:10 kennykb Exp $
+# RCS: @(#) $Id: io.test,v 1.80.2.4 2008/04/07 22:33:30 andreas_kupries Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -6981,6 +6981,76 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
catch {removeFile err}
catch {unset ::forever}
} -result OK
+test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+ set err [makeFile {} err]
+ set pipe [open "|[info nameofexecutable] 2> $err" r+]
+ fconfigure $pipe -translation binary -buffering line
+ puts $pipe {
+ fconfigure stderr -buffering line
+ # Kill server when pipe closed by invoker.
+ proc bye args {
+ if {![eof stdin]} { gets stdin ; return }
+ puts stderr BYE
+ exit
+ }
+ # Server code. Bi-directional copy between 2 sockets.
+ proc geof {sok} {
+ puts stderr DONE/$sok
+ close $sok
+ }
+ proc new {sok args} {
+ puts stderr NEW/$sok
+ global l srv
+ fconfigure $sok -translation binary -buffering none
+ lappend l $sok
+ if {[llength $l]==2} {
+ close $srv
+ foreach {a b} $l break
+ fcopy $a $b -command [list geof $a]
+ fcopy $b $a -command [list geof $b]
+ puts stderr 2COPY
+ }
+ puts stderr ...
+ }
+ puts stderr SRV
+ set l {}
+ set srv [socket -server new 9999]
+ puts stderr WAITING
+ fileevent stdin readable bye
+ puts OK
+ vwait forever
+ }
+ # wait for OK from server.
+ gets $pipe
+ # Now the two clients.
+ proc ::done {sock} {
+ if {[eof $sock]} { close $sock ; return }
+ lappend ::forever [gets $sock]
+ return
+ }
+ set a [socket 127.0.0.1 9999]
+ set b [socket 127.0.0.1 9999]
+ fconfigure $a -translation binary -buffering none
+ fconfigure $b -translation binary -buffering none
+ fileevent $a readable [list ::done $a]
+ fileevent $b readable [list ::done $b]
+} -constraints {stdio openpipe fcopy} -body {
+ # Now pass data through the server in both directions.
+ set ::forever {}
+ puts $a AB
+ vwait ::forever
+ puts $b BA
+ vwait ::forever
+ set ::forever
+} -cleanup {
+ catch {close $a}
+ catch {close $b}
+ close $pipe
+ rename ::done {}
+ after 1000 ;# Give Windows time to kill the process
+ removeFile err
+ catch {unset ::forever}
+} -result {AB BA}
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive