diff options
-rw-r--r-- | tests/socket.test | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/tests/socket.test b/tests/socket.test index 29dd677..2bd2731 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -679,6 +679,48 @@ test socket_$af-2.12 {} [list socket stdio supported_$af] { close $f set ::done } 0 +test socket_$af-2.13 {Bug 1758a0b603} {socket stdio} { + file delete $path(script) + set f [open $path(script) w] + puts $f { + set server [socket -server accept 0] + puts [lindex [chan configure $server -sockname] 2] + proc accept { client host port } { + chan configure $client -blocking 0 -buffering line -buffersize 1 + puts $client [string repeat . 720000] + puts ready + chan event $client writable [list setup $client] + } + proc setup client { + chan event $client writable {set forever write} + after 5 {set forever timeout} + } + vwait forever + puts $forever + } + close $f + set pipe [open |[list [interpreter] $path(script)] r] + gets $pipe port + set sock [socket $localhost $port] + chan configure $sock -blocking 0 -buffering line + chan event $sock readable [list read_lines $sock $pipe ] + proc read_lines { sock pipe } { + gets $pipe + gets $sock line + after idle [list stop $sock $pipe] + chan event $sock readable {} + } + proc stop {sock pipe} { + variable done + close $sock + set done [gets $pipe] + } + variable done + vwait [namespace which -variable done] + close $pipe + set done +} write + test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup { file delete $path(script) set f [open $path(script) w] |