summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-06-16 12:19:30 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-06-16 12:19:30 (GMT)
commita7715c1f256468c712c4db021b7ecc7603efe2b2 (patch)
treea04493a82d3557db3056d8b61bba7338a877a9b6
parent31c57051e72eb8b545de3e43ed6fd77d62db67f9 (diff)
parent2aea826894f2e787994224a7cd6b2f1023c42c4f (diff)
downloadtcl-a7715c1f256468c712c4db021b7ecc7603efe2b2.zip
tcl-a7715c1f256468c712c4db021b7ecc7603efe2b2.tar.gz
tcl-a7715c1f256468c712c4db021b7ecc7603efe2b2.tar.bz2
merge socket test from 8.5
-rw-r--r--tests/socket.test42
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]