397 lines
8.3 KiB
Plaintext
397 lines
8.3 KiB
Plaintext
source [file dirname [info script]]/testing.tcl
|
|
|
|
needs constraint jim
|
|
needs cmd socket
|
|
needs cmd os.fork
|
|
|
|
catch {[socket -ipv6 stream {[::1]:5000}]} res
|
|
set ipv6 1
|
|
if {[string match "*not supported" $res]} {
|
|
set ipv6 0
|
|
} else {
|
|
# Also, if we can't bind an IPv6 socket, don't run IPv6 tests
|
|
if {[catch {
|
|
[socket -ipv6 stream.server {[::1]:5000}] close
|
|
} msg opts]} {
|
|
set ipv6 0
|
|
}
|
|
}
|
|
testConstraint ipv6 $ipv6
|
|
|
|
# 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
|
|
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]]
|
|
# Note: We have to disable buffering here, otherwise
|
|
# when we read data in $c readable {} we many leave buffered
|
|
# data and readable won't retrigger.
|
|
$c buffering none
|
|
$s close
|
|
$c readable {
|
|
# when we read we need to also read any pending data,
|
|
# otherwise readable won't retrigger
|
|
set buf [$c read 1]
|
|
if {[string length $buf] == 0} {
|
|
incr readdone
|
|
$c close
|
|
} else {
|
|
$c puts -nonewline $buf
|
|
}
|
|
}
|
|
vwait readdone
|
|
exit 99
|
|
}
|
|
|
|
# Now set up the server
|
|
set cs [$s accept addr]
|
|
defer {
|
|
$cs close
|
|
}
|
|
$s close
|
|
|
|
# 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/gets} {
|
|
$cs puts -nonewline again
|
|
lmap p [range 5] {
|
|
set c [$cs read 1]
|
|
set c
|
|
}
|
|
} {a g a i n}
|
|
|
|
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
|