source [file dirname [info script]]/testing.tcl needs constraint jim needs cmd socket needs cmd os.fork constraint eval ipv6 {[socket -ipv6 stream.server ::1:5000] close} # Given an IPv4 or IPv6 server socket, return an address # that a client can use to connect to the socket. # This handles the case where the server is listening on (say) 0.0.0.0:5000 # but some systems need the client to connect on localhost:5000 proc socket-connect-addr {s} { if {[regexp {(.*):([^:]+)} [$s sockname] -> host port]} { if {$host eq "0.0.0.0"} { return 127.0.0.1:$port } elseif {$host eq {[::]}} { return \[::1\]:$port } } return [$s sockname] } test socket-1.1 {stream} -body { # Let the system choose a port set s [socket stream.server 127.0.0.1:0] stdout flush if {[os.fork] == 0} { # child set c [socket stream [$s sockname]] $s close $c puts hello $c close exit 99 } set cs [$s accept] $cs gets buf $cs close $s close set buf } -result {hello} test socket-1.2 {dgram - connected} -body { # Let the system choose a port set s [socket dgram.server 127.0.0.1:0] set c [socket dgram [$s sockname]] $s buffering none $c buffering none $c puts -nonewline hello set buf [$s recv 1000] $c close $s close set buf } -result {hello} test socket-1.3 {dgram - unconnected} -body { # Let the system choose a port set s [socket dgram.server 127.0.0.1:0] set c [socket dgram] $s buffering none $c buffering none $c sendto hello [$s sockname] set buf [$s recv 1000] $c close $s close set buf } -result {hello} test socket-1.4 {unix} -body { set path [file tempfile] file delete $path set s [socket unix.server $path] stdout flush if {[os.fork] == 0} { # child set c [socket unix [$s sockname]] $s close $c puts hello $c close exit 99 } set cs [$s accept] $cs gets buf $cs close $s close set buf } -result {hello} test socket-1.5 {unix.dgram} -body { set path [file tempfile] file delete $path set s [socket unix.dgram.server $path] set c [socket unix.dgram [$s sockname]] $s buffering none $c buffering none $c puts -nonewline hello set buf [$s recv 1000] $s close $c close set buf } -result {hello} test socket-1.6 {pipe} -body { lassign [socket pipe] r w stdout flush if {[os.fork] == 0} { $r close $w puts hello $w close exit 99 } $w close $r gets buf $r close set buf } -result {hello} test socket-1.7 {socketpair} -body { lassign [socket pair] s1 s2 $s1 buffering line $s2 buffering line stdout flush if {[os.fork] == 0} { $s1 close # Read data and send it back $s2 gets buf $s2 puts $buf $s2 close exit 99 } $s2 close $s1 puts hello $s1 gets buf $s1 close set buf } -result {hello} test socket-1.8 {stream - ipv6} -constraints ipv6 -body { # Let the system choose a port set s [socket -ipv6 stream.server {[::1]:0}] stdout flush if {[os.fork] == 0} { # child set c [socket -ipv6 stream [$s sockname]] $s close $c puts hello $c close exit 99 } set cs [$s accept] $cs gets buf $cs close $s close set buf } -result {hello} test socket-1.9 {dgram - ipv6 - unconnected} -constraints ipv6 -body { # Let the system choose a port set s [socket -ipv6 dgram.server {[::1]:0}] set c [socket -ipv6 dgram] $s buffering none $c buffering none $c sendto hello [$s sockname] set buf [$s recv 1000] $c close $s close set buf } -result {hello} test socket-1.10 {stream - port only} -body { set s [socket stream.server 0] stdout flush if {[os.fork] == 0} { # child set c [socket stream [socket-connect-addr $s]] $s close $c puts hello $c close exit 99 } set cs [$s accept] $cs gets buf $cs close $s close set buf } -result {hello} test socket-1.11 {stream - ipv6 - port only} -constraints ipv6 -body { # Let the system choose a port set s [socket -ipv6 stream.server 0] stdout flush if {[os.fork] == 0} { # child set c [socket -ipv6 stream [socket-connect-addr $s]] $s close $c puts hello $c close exit 99 } set cs [$s accept] $cs gets buf $cs close $s close set buf } -result {hello} test socket-2.1 {read 1} -body { lassign [socket pipe] r w $w puts -nonewline hello $w close set chars {} while {1} { set c [$r read 1] if {$c eq ""} { break } lappend chars $c } $r close set chars } -result {h e l l o} test socket-2.2 {read to EOF} -body { lassign [socket pipe] r w $w puts -nonewline hello $w close set buf [$r read] $r close set buf } -result {hello} test socket-2.3 {read -nonewline} -body { lassign [socket pipe] r w $w puts hello $w close set buf [$r read -nonewline] $r close set buf } -result {hello} test socket-2.4 {isatty} -body { lassign [socket pipe] r w set result [list [$r isatty] [$w isatty]] $r close $w close set result } -result {0 0} test socket-2.5 {peername} -body { set s [socket stream.server 0] stdout flush if {[os.fork] == 0} { try { set c [socket stream [socket-connect-addr $s]] $s close $c puts [list [$c sockname] [$c peername]] $c close } on error msg { stderr puts $msg } exit 99 } set cs [$s accept] lassign [$cs gets] c_sockname c_peername if {$c_sockname ne [$cs peername]} { error "client sockname=$c_sockname not equal to server peername=[$cs peername]" } if {$c_peername ne [$cs sockname]} { error "client peername=$c_peername not equal to server sockname=[$cs sockname]" } $cs close $s close } -result {} test socket-3.1 {listen} { set s [socket stream.server 0] $s listen 10 $s close } {} test socket-3.2 {listen usage} -body { set s [socket stream.server 0] $s listen } -returnCodes error -match glob -result {wrong # args: should be "* listen backlog"} -cleanup { $s close } test socket-3.3 {listen usage} -body { set s [socket stream.server 0] $s listen blah } -returnCodes error -match glob -result {expected integer but got "blah"} -cleanup { $s close } test socket-3.4 {listen not a socket} -body { set f [open [info script]] $f listen 10 } -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { $f close } test socket-4.1 {invalid ipv6 address} -constraints ipv6 -body { socket -ipv6 stream "- invalid - address -" } -returnCodes error -result {Not a valid address: :::- invalid - address -} test socket-4.2 {invalid ipv4 address} -body { socket stream {9.9.9.9.9:0} } -returnCodes error -result {Not a valid address: 9.9.9.9.9:0} test socket-4.3 {sockname on non-socket} -body { set f [open [info script]] $f sockname } -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { $f close } test socket-4.4 {peername on non-socket} -body { set f [open [info script]] $f peername } -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { $f close } # For the eventloop tests, let's set up a client and a server where the client # simply echos everything back to the server set s [socket stream.server 0] if {[os.fork] == 0} { # child set c [socket stream [socket-connect-addr $s]] $s close $c ndelay 1 $c readable { # read everything available (non-blocking read) set buf [$c read] if {[string length $buf]} { $c puts -nonewline $buf $c flush } if {[$c eof]} { incr readdone $c close } } vwait readdone exit 99 } # Now set up the server set cs [$s accept addr] defer { $cs close } $s close $cs buffering line # At this point, $cs is the server connection to the client in the child process test eventloop-1.1 {puts/gets} { $cs puts hello $cs gets } hello test eventloop-1.2 {puts/read} { $cs puts -nonewline again $cs flush lmap p [range 5] { set c [$cs read 1] set c } } {a g a i n} test eventloop-1.3 {gets with no timeout and multiple newlines} { $cs puts a\nb\nc\nd\ne lmap p [range 5] { $cs gets buf set buf } } {a b c d e} test eventloop-1.4 {gets with timeout and multiple newlines} { $cs timeout 100 $cs puts a\nb\nc\nd\ne lmap p [range 6] { set rc [$cs gets buf] set buf } } {a b c d e {}} test eventloop-1.5 {gets with timeout and incomplete line} { $cs timeout 100 $cs puts -nonewline first list [$cs gets buf] $buf } {-1 {}} test eventloop-1.6 {gets with timeout and complete line} { $cs timeout 100 $cs puts second list [$cs gets buf] $buf } {11 firstsecond} test eventloop-1.7 {gets when read with extra data} { $cs timeout 100 $cs puts -nonewline abcde $cs flush # This won't get get a line $cs gets line # now read should read the data set data [$cs read -nonewline] list $line $data } {{} abcde} test eventloop-1.7 {read with timeout and no data} { $cs timeout 100 $cs read } {} test eventloop-1.6 {read with timeout and data} { $cs timeout 100 $cs puts -nonewline data $cs flush $cs read } {data} test sockopt-1.1 {sockopt} -body { lsort [dict keys [$cs sockopt]] } -match glob -result {*tcp_nodelay*} test sockopt-1.2 {sockopt set} { $cs sockopt tcp_nodelay 1 dict get [$cs sockopt] tcp_nodelay } 1 test sockopt-1.3 {sockopt set invalid} -body { $cs sockopt tcp_nodelay badbool } -returnCodes error -result {expected boolean but got "badbool"} testreport