#########################################
#
# RPC test suite for Tcl-DP 4.0
#

if {[string compare test [info procs test]] == 1} then {source defs}
source ../library/rpc.tcl
source ../library/dp_atexit.tcl
catch {source ../library/dp_atclose.tcl}
source make-server
proc MyCheck {args} {}

proc fileserv {filename} {
    set openfile [open $filename r]
    read $openfile
}

catch {dp_atexit clear}

set hostinet [dp_netinfo -address $hostname]

#----------------------------------------------------------------------
#
# Connectivity tests
#
test rpc-1.1 {creation of rpc client using hostname} {
    list [catch {
    	set server1 [dp_MakeRPCClient $hostname $S_PORT]
	string match tcp* $server1
    } msg] $msg
} {0 1}

test rpc-1.2 {creation of rpc client using internet address} {
    list [catch {
    	set server2 [dp_MakeRPCClient $hostinet $S_PORT]
	string match tcp* $server2
    } msg] $msg
} {0 1}


# This if controls whether the rest of the tests will be performed.
#
if {[string match tcp* $server1] & [string match tcp* $server2]} {

#------------------------------------------------------------------------------
#
# Basic message passing tests
#
test rpc-2.1 {Basic message passing} {
    list [catch {
	dp_RPC $server1 set mike rules
    } msg] $msg
} {0 rules}

test rpc-2.2 {basic error handling} {
    list [catch {
    	dp_RPC $server1 set a
    } msg] $msg
} {1 {can't read "a": no such variable}}

test rpc-2.3 {timeout routines} {
    list [catch {
   	catch { dp_RPC $server1 -timeout 50 after 1000 } msg
	string match "RPC timed out on channel tcp*" $msg
    } msg] $msg
} {0 1}

proc errorTest {file} {
    return "Caught error on $file"
}

test rpc-2.4 {timeout routines} {
    list [catch {
    	set rc [dp_RPC $server1 -timeout 50 -timeoutReturn errorTest after 1000]
    	string match "Caught error on tcp*" $rc
    } msg] $msg
} {0 1}


# tests dp_CancelRPC when it's given a filehandle and when it isn't 
test rpc-2.5 {cancel rpc test} {
    after idle dp_CancelRPC $server1
    catch {dp_RPC $server1 -timeout 5000 -timeoutReturn puts -events idle after 5000} msg
    after idle dp_CancelRPC all
    catch {dp_RPC $server1 -timeout 5000 -timeoutReturn puts -events idle after 5000} msg1
    set xx [list [string match "RPC cancelled on channel tcp*" $msg] \
    	 [string match "RPC cancelled on channel tcp*" $msg1] ]
} {1 1}


# this test tells the remote server to open up another socket, using 
# dp_connect -server and dp_accept (at the server!).  Then it calls
# the new connection to make sure that RPCs work.
test rpc-2.6 {RPC test} {

    global id remfile newfile

    list [catch {
	# tell the remote interpreter to open up another listening server

	set id [dp_RPC $server1 dp_connect tcp -server true -myport 9901]
	set port [dp_RPC $server1 fconfigure $id -myport]
	
	dp_RDO $server1 eval "set remfile \[lindex \[dp_accept $id\] 0\]"

	# connect to the new server, get both the file representing the 
	# connection on this side ($newfile) and on the remote side ($remfile)
	set newfile [dp_connect tcp -host $hostname -port 9901]
	dp_admin register $newfile
	set remfile [dp_RPC $server1 set remfile]

	catch {dp_RPC $server1 dp_admin register $remfile} msg

	# send a simple RPC
	dp_RPC $newfile set test 33

	# now use the original RPC connection to test whether the other RPC 
	# worked.
	list [catch {
	    dp_RPC $server1 -timeout 10000 -timeoutReturn puts set test
	} msg]
    } msg2] [list $msg2 $msg]
} {0 {0 33}}

# this tests if we will correctly handle 
# multiple RPCs while waiting.  Also tests what happens when
# a badly formatted RPC packet is sent to the socket waiting
# for rpc messages.  Third, tests if RPCs can handle getting
# return values in multiple packets.
test rpc-2.7 {multiple RPCs with waiting} {
    list [catch {
	global id remfile newfile

	for {set i 0} {$i < 500} {incr i} {
	    dp_RPC $newfile set a $i
	}

	# set up the fileserver proc on the remoter server
	dp_RPC $newfile proc fileserv {filename} {
	    set openfile [open $filename r]
	    read $openfile
	}

	# read over a large file (dpRPC.c) to force dp_RPC to get
	# it's return value in multiple packets.
	cd ..
	set path [pwd]
	set filename $path/generic/dpRPC.c
	cd tests
	dp_RPC $newfile fileserv $filename
	catch {dp_RPC $newfile -timeout 10 fileserv $filename}

	dp_RPC $newfile dp_RPC $remfile set a 33
	set result [dp_RPC $newfile set a]

	list $a $result
    } msg2] $msg2
} {0 {33 499}}
after idle catch {close $newfile}

# tests to make sure nested RPC's are allowed
test rpc-2.8 {nested RPC test} {
    list [catch {
	dp_RPC $server1 set a 100
	after idle {catch {dp_RPC $server1 set a 9} msg}
	dp_RPC $server1 -events {rpc idle} after 5000
	set a [dp_RPC $server1 set a]
	list $a $msg
    } msg2] $msg2
} {0 {9 9}}

# a silly little test to make sure dp correctly processes all event flags.
test rpc-2.9 {rpc event list test} {
    list [catch {
	dp_RPC $server1 -events [list x rpc file timer idle all none] set a 9
    } msg] $msg
} {0 9}

#------------------------------------------------------------------------------
#
# RDO tests
#

test rpc-3.1 {Basic RDO} {
    list [catch {
	dp_RPC $server1 catch {unset a}
	dp_RDO $server1 set a rpc-3.1
	dp_RPC $server1 set a
    } msg] $msg
} {0 rpc-3.1}

test rpc-3.2 {Basic RDO with callback} {
    list [catch {
	set rdoResults 0
	dp_RDO $server1 set a rpc-3.2
	dp_RDO $server1 -callback "set rdoResults" set a
	dp_RPC $server1 set a synchronize
	set rdoResults
    } msg] $msg
} {0 rpc-3.2}

test rpc-3.3 {Multiple RDOs, each with callback} {
    list [catch {
	set RDO1 0
	set RDO2 0
	dp_RDO $server1 -callback "set RDO1" set a 3.3a
	dp_RDO $server1 -callback "set RDO2" set a 3.3b
	dp_RPC $server1 -events all set a synchronize
	list $RDO1 $RDO2
    } msg] $msg
} {0 {3.3a 3.3b}}

test rpc-3.4 {Basic RDO error handling} {
    list [catch {
	set RDOerr 0
	dp_RDO $server1 unset a
	dp_RDO $server1 -onerror "set RDOerr" set a
	dp_RPC $server1 set a synchronize
	set RDOerr
    } msg] $msg
} {0 {can't read "a": no such variable}}

test rpc-3.5 {Basic RDO error generation (error will crash test)} {
    list [catch {
    	unset msg
	dp_RPC $server1 -events all unset a
	catch {dp_RDO $server1 -onerror none set a}
    } msg] $msg
} {0 0}

test rpc-3.6 {RDO error handling for multiple RDO's} {
    list [catch {
	set RDOerr1 rpc-3.6a
	set RDOerr2 rpc-3.6b
	dp_RDO $server1 -onerror none unset a
	dp_RDO $server1 -onerror none unset b
	dp_RDO $server1 -onerror "set RDOerr1" set a
	dp_RDO $server1 -onerror "set RDOerr2" set b
	dp_RPC $server1 set a synchronize
	list $RDOerr1 $RDOerr2
    } msg] $msg
} {0 {{can't read "a": no such variable} {can't read "b": no such variable}}}

test rpc-3.7 {RDO callback handling for multiple RDO's} {
    list [catch {
	set RDO1    rpc3.7a
	set RDO2    rpc3.7b
	dp_RDO $server1 set a rpc3.7c
	dp_RDO $server1 -onerror none unset b
	dp_RDO $server1 -onerror none -callback "set RDO1" set a
	dp_RDO $server1 -onerror none -callback "set RDO2" set b
	dp_RPC $server1 set a synchronize
	list $RDO1 $RDO2
    } msg] $msg
} {0 {rpc3.7c rpc3.7b}}

test rpc-3.8 {Mixed RDO error and callback handling for multiple RDO's} {
    list [catch {
	set RDOerr1 rpc3.8a
	set RDOerr2 rpc3.8b
	set RDO1    rpc3.8c
	set RDO2    rpc3.8d
	dp_RDO $server1 set a hello
	dp_RDO $server1 -onerror none unset b
	dp_RDO $server1 -callback "set RDO1" -onerror "set RDOerr1" set a
	dp_RDO $server1 -callback "set RDO2" -onerror "set RDOerr2" set b
	dp_RPC $server1 set a synchronize
	list $RDOerr1 $RDOerr2 $RDO1 $RDO2
    } msg] $msg
} {0 {rpc3.8a {can't read "b": no such variable} hello rpc3.8d}}

test rpc-3.9 {mixed RPC and RDO with timeout} {
    list [catch {
	set RDO1    rpc3.9a
	set RDO2    rpc3.9b
	dp_RDO $server1 -callback "set RDO1" set a rpc3.9c
	set rv1 [catch {dp_RPC $server1 -timeout 50 after 1000} msg1]
	dp_RDO $server1 -callback "set RDO2" set a rpc3.9d
	set rv2 [catch {dp_RPC $server1 set a rpc3.9e} msg2]
	set msg2 [string match "RPC timed out*" $msg1]
	list $rv1 $rv2 $RDO1 $RDO2 
    } msg] $msg
} {0 {1 0 rpc3.9c rpc3.9d}}


#------------------------------------------------------------------------------
#
# Shutdown protocol tests
#
test rpc-4.1 {proper closing one end of an RPC} {
    list [catch {
	close $server1
    } msg] $msg
} {0 {}}

test rpc-4.2 {check dp_atexit list} {
    list [catch {
	string match "\{close $server2\}" [dp_atexit list]
    } msg] $msg
} {0 1}

test rpc-4.3 {close the remote interpreter} {
    list [catch {
	dp_RDO $server2 exit
    } msg] $msg
} {0 {}}

catch {close $server2}

test rpc-4.4 {check dp_atclose list} {
    list [catch {
	list [dp_atclose $server1 list] [dp_atclose $server2 list]
    } msg] $msg
} {0 {{} {}}}

test rpc-4.5 {check server crashing} {
    list [
    	set rc [catch {close $server1} msg1]
    	string match "can not find channel named*" $msg1
    ] $rc
} {1 1}

} else {

    # reset variable so server will quit also
    # just in case the channel is still viable.
    catch {dp_RDO $server1 set forever 42}
    return
}