diff options
author | dgp <dgp@users.sourceforge.net> | 2014-06-05 19:06:08 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2014-06-05 19:06:08 (GMT) |
commit | 2be0ba5d68aaf52c90586aa91cc877a835b58df3 (patch) | |
tree | 91e2cb41c810a2e7de889f5aa84660f824fc324a | |
parent | 457182886821a26e8470e57319fa58d9b3f0deeb (diff) | |
download | tcl-2be0ba5d68aaf52c90586aa91cc877a835b58df3.zip tcl-2be0ba5d68aaf52c90586aa91cc877a835b58df3.tar.gz tcl-2be0ba5d68aaf52c90586aa91cc877a835b58df3.tar.bz2 |
Test socket-2.12 covers the DiscardOutput() update.
-rw-r--r-- | tests/socket.test | 40 |
1 files changed, 39 insertions, 1 deletions
diff --git a/tests/socket.test b/tests/socket.test index 1b7c5fa..2953c39 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -577,7 +577,45 @@ test socket-2.11 {detecting new data} {socket} { close $sock set result } {a:one b: c:two} - +test socket-2.12 {} {socket stdio} { + file delete $path(script) + set f [open $path(script) w] + puts $f { + set server [socket -server accept_client 0] + puts [lindex [chan configure $server -sockname] 2] + proc accept_client { client host port } { + chan configure $client -blocking 0 -buffering line + write_line $client + } + proc write_line client { + if { [catch { chan puts $client [string repeat . 720000]}] } { + puts [catch {chan close $client}] + } else { + puts signal1 + after 0 write_line $client + } + } + chan event stdin readable {set forever now} + vwait forever + exit + } + close $f + set f [open "|[list [interpreter] $path(script)]" r+] + gets $f port + set sock [socket 127.0.0.1 $port] + chan event $sock readable [list read_lines $sock $f] + proc read_lines { sock pipe } { + gets $pipe + chan close $sock + chan event $pipe readable [list readpipe $pipe] + } + proc readpipe {pipe} { + while {![string is integer [set ::done [gets $pipe]]]} {} + } + vwait ::done + close $f + set ::done +} 0 test socket-3.1 {socket conflict} {socket stdio} { file delete $path(script) |