summaryrefslogtreecommitdiffstats
path: root/tests/chanio.test
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 /tests/chanio.test
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.
Diffstat (limited to 'tests/chanio.test')
-rw-r--r--tests/chanio.test72
1 files changed, 71 insertions, 1 deletions
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