archie/tcl-dp/tests/tcp.test

# 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}