archie/tcl-dp/tests/tcp.test
2024-05-27 16:13:40 +02:00

267 lines
6.7 KiB
Plaintext

# tcp.test --
#
# Test the TCP protocol
#
if {[string compare test [info procs test]] == 1} then {source ../tests/defs}
test tcp-1.1 {dp_connect command} {
list [catch {
dp_connect tcp -bar
} msg] $msg
} {1 {unknown option "-bar", must be -async, -host, -myaddr, -myport -port or -server}}
test tcp-1.2 {dp_connect command} {
list [catch {
dp_connect tcp -bar foo
} msg] $msg
} {1 {unknown option "-bar", must be -async, -host, -myaddr, -myport -port or -server}}
test tcp-1.3 {dp_connect command} {
list [catch {
dp_connect tcp -port
} msg] $msg
} {1 {value for "-port" missing}}
test tcp-1.4 {dp_connect command} {
list [catch {
dp_connect tcp
} msg] $msg
} {1 {option -port must be specified for clients}}
test tcp-1.5 {dp_connect command} {
list [catch {
dp_connect tcp -port badport
} msg] $msg
} {1 {expected integer but got "badport"}}
test tcp-1.6 {dp_connect command} {
list [catch {
dp_connect tcp -server 1
} msg] $msg
} {1 {option -myport must be specified for servers}}
test tcp-1.7 {dp_connect command} {
list [catch {
dp_connect tcp -server 1 -myport 1234 -async 1
} msg] $msg
} {1 {option -async is not valid for servers}}
test tcp-1.8 {dp_connect command} {
list [catch {
dp_connect tcp -server 1 -myport 1234 -host localhost
} msg] $msg
} {1 {option -host is not valid for servers}}
test tcp-1.9 {dp_connect command} {
list [catch {
dp_connect tcp -server 1 -myport 1234 -port 1234
} msg] $msg
} {1 {option -port is not valid for servers}}
test tcp-2.0.1 {Opening port with no service.} {
list [catch {
set csock [dp_connect tcp -host localhost -port 14466]
} msg] $msg
} {1 {couldn't open socket: connection refused}}
test tcp-2.1 {dp_accept command} {
list [catch {dp_accept} message] $message
} {1 {wrong # args: should be "dp_accept channelId"}}
test tcp-2.2 {dp_accept command} {
list [catch {
set ssock [dp_connect tcp -server 1 -myport 14467]
set csock [dp_connect tcp -host localhost -port 14467]
after 500
set asock [lindex [dp_accept $ssock] 0]
puts $csock hello1
set line [gets $asock]
} msg] $msg
} {0 hello1}
catch {close $ssock}
catch {close $csock}
catch {close $asock}
test tcp-2.3 {Closing of server sockets} {
list [catch {
set csock [dp_connect tcp -host localhost -port 14470]
} msg] $msg
} {1 {couldn't open socket: connection refused}}
catch {close $csock}
test tcp-2.4 {Closing of client sockets} {
set ssock [dp_connect tcp -server 1 -myport 14468]
set csock [dp_connect tcp -host localhost -port 14468 -async 1]
after 500
set asock [lindex [dp_accept $ssock] 0]
close $asock
after 1000
catch {
puts $csock hello1
} msg
regexp {^error writing} $msg
} [regexp {^error writing} {error writing "tcp2": broken pipe}]
catch {close $csock}
catch {close $ssock}
test tcp-2.5 {asynchronous client Tcp socket} {
list [catch {
set ssock [dp_connect tcp -server 1 -myport 14469]
set csock [dp_connect tcp -host localhost -port 14469 -myport 14470 -async 1]
after 500
set asock [lindex [dp_accept $ssock] 0]
puts $csock hello1
set line [gets $asock]
} msg] $msg
} {0 hello1}
#
# fconfigure tests
#
catch {set myIpAddr [dp_netinfo -address [info hostname]]}
if {$myIpAddr == 0} {
puts stdout "Error determining IP address"
}
test tcp-2.6.1.1 "fconfigure tcp (ssock)" {
list [catch {
fconfigure $ssock
} msg] $msg
} [list 0 [list -blocking 1 -buffering none -buffersize 4096 -eofchar {{} {}} -translation {lf lf} -keepAlive 0 -linger 0 -recvBuffer 8192 -reuseAddr 1 -sendBuffer 8192 -myIpAddr $myIpAddr -myport 14469 -destIpAddr 0.0.0.0 -destport 0]]
test tcp-2.6.1.2 "fconfigure tcp (csock)" {
list [catch {
fconfigure $csock
} msg] $msg
} [list 0 [list -blocking 1 -buffering none -buffersize 4096 -eofchar {{} {}} -translation {lf lf} -keepAlive 0 -linger 0 -recvBuffer 8192 -reuseAddr 1 -sendBuffer 8192 -myIpAddr $myIpAddr -myport 14470 -destIpAddr 127.0.0.1 -destport 14469]]
test tcp-2.6.1.2 "fconfigure tcp (asock)" {
list [catch {
fconfigure $asock
} msg] $msg
} [list 0 [list -blocking 1 -buffering none -buffersize 4096 -eofchar {{} {}} -translation {lf lf} -keepAlive 0 -linger 0 -recvBuffer 8192 -reuseAddr 1 -sendBuffer 8192 -myIpAddr $myIpAddr -myport 14469 -destIpAddr 127.0.0.1 -destport 14470]]
test tcp-2.6 {fconfigure tcp} {
foreach type "ssock csock asock" {
set sock [set $type]
test tcp-2.6.2 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -blocking 0
} msg] $msg
} {0 {}}
test tcp-2.6.3 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -blocking
} msg] $msg
} {0 0}
test tcp-2.6.4 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -sendBuffer 4096
} msg] $msg
} {0 {}}
test tcp-2.6.5 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -sendBuffer
} msg] $msg
} {0 4096}
test tcp-2.6.6 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -sendBuffer -1
} msg] $msg
} {1 {Buffer size must be > 0}}
test tcp-2.6.7 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -sendBuffer foo
} msg] $msg
} {1 {expected integer but got "foo"}}
test tcp-2.6.8 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -recvBuffer 4096
} msg] $msg
} {0 {}}
test tcp-2.6.9 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -recvBuffer
} msg] $msg
} {0 4096}
test tcp-2.6.10 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -recvBuffer -1
} msg] $msg
} {1 {Buffer size must be > 0}}
test tcp-2.6.11 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock -recvBuffer foo
} msg] $msg
} {1 {expected integer but got "foo"}}
foreach opt {-keepAlive -reuseAddr} {
test tcp-2.6.12.0 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock $opt foo
} msg] $msg
} {1 {expected boolean value but got "foo"}}
test tcp-2.6.12.1 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock $opt 0
} msg] $msg
} {0 {}}
test tcp-2.6.12.2 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock $opt
} msg] $msg
} {0 0}
test tcp-2.6.12.3 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock $opt 1
} msg] $msg
} {0 {}}
test tcp-2.6.12.4 "fconfigure tcp ($type)" {
list [catch {
fconfigure $sock $opt
} msg] $msg
} {0 1}
}
}
set result_is ok
} ok
catch {close $ssock}
catch {close $csock}
catch {close $asock}
# CORNELL ONLY TESTS
# (ToDo) Connect to a "test server" instead.
#
test cornell-tcp-3.1 {dp_connect command} {
set chan [dp_connect tcp -host www -port 80]
puts $chan "GET /"
flush $chan
string range [gets $chan] 0 5
} {<!DOCT}