summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-06-05 19:13:09 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-06-05 19:13:09 (GMT)
commit1839434f32f737c9fb5c3eb0ebec71b3cccfb581 (patch)
tree2382d5105b9a74f04ed83a84709811d346fe51c1
parent54eb626870a445ace6d45d1a897ebbe0860297e1 (diff)
parent2be0ba5d68aaf52c90586aa91cc877a835b58df3 (diff)
downloadtcl-1839434f32f737c9fb5c3eb0ebec71b3cccfb581.zip
tcl-1839434f32f737c9fb5c3eb0ebec71b3cccfb581.tar.gz
tcl-1839434f32f737c9fb5c3eb0ebec71b3cccfb581.tar.bz2
Tests socket*-2.12 test for DiscardOutput() updates.
-rw-r--r--tests/socket.test40
1 files changed, 39 insertions, 1 deletions
diff --git a/tests/socket.test b/tests/socket.test
index 0c9320a..29dd677 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -640,7 +640,45 @@ test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$a
close $s
close $sock
} -result {a:one b: c:two}
-
+test socket_$af-2.12 {} [list socket stdio supported_$af] {
+ 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 $localhost $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_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup {
file delete $path(script)
set f [open $path(script) w]