Test: code to test server availability refactored.
Some inline test moved into server_is_up procedure. Also find_available_port was moved into util since it is going to be used for the Sentinel test as well.
This commit is contained in:
parent
ede33fb912
commit
a1dca2efab
@ -79,7 +79,7 @@ proc is_alive config {
|
||||
proc ping_server {host port} {
|
||||
set retval 0
|
||||
if {[catch {
|
||||
set fd [socket $::host $::port]
|
||||
set fd [socket $host $port]
|
||||
fconfigure $fd -translation binary
|
||||
puts $fd "PING\r\n"
|
||||
flush $fd
|
||||
@ -101,6 +101,22 @@ proc ping_server {host port} {
|
||||
return $retval
|
||||
}
|
||||
|
||||
# Return 1 if the server at the specified addr is reachable by PING, otherwise
|
||||
# returns 0. Performs a try every 50 milliseconds for the specified number
|
||||
# of retries.
|
||||
proc server_is_up {host port retrynum} {
|
||||
after 10 ;# Use a small delay to make likely a first-try success.
|
||||
set retval 0
|
||||
while {[incr retrynum -1]} {
|
||||
if {[catch {ping_server $host $port} ping]} {
|
||||
set ping 0
|
||||
}
|
||||
if {$ping} {return 1}
|
||||
after 50
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
# doesn't really belong here, but highly coupled to code in start_server
|
||||
proc tags {tags code} {
|
||||
set ::tags [concat $::tags $tags]
|
||||
@ -191,23 +207,13 @@ proc start_server {options {code undefined}} {
|
||||
# check that the server actually started
|
||||
# ugly but tries to be as fast as possible...
|
||||
if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
|
||||
set serverisup 0
|
||||
|
||||
if {$::verbose} {
|
||||
puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
|
||||
}
|
||||
|
||||
after 10
|
||||
if {$code ne "undefined"} {
|
||||
while {[incr retrynum -1]} {
|
||||
catch {
|
||||
if {[ping_server $::host $::port]} {
|
||||
set serverisup 1
|
||||
}
|
||||
}
|
||||
if {$serverisup} break
|
||||
after 50
|
||||
}
|
||||
set serverisup [server_is_up $::host $::port $retrynum]
|
||||
} else {
|
||||
set serverisup 1
|
||||
}
|
||||
|
@ -312,3 +312,18 @@ proc csvstring s {
|
||||
proc roundFloat f {
|
||||
format "%.10g" $f
|
||||
}
|
||||
|
||||
proc find_available_port start {
|
||||
for {set j $start} {$j < $start+1024} {incr j} {
|
||||
if {[catch {
|
||||
set fd [socket 127.0.0.1 $j]
|
||||
}]} {
|
||||
return $j
|
||||
} else {
|
||||
close $fd
|
||||
}
|
||||
}
|
||||
if {$j == $start+1024} {
|
||||
error "Can't find a non busy port in the $start-[expr {$start+1023}] range."
|
||||
}
|
||||
}
|
||||
|
@ -164,21 +164,6 @@ proc cleanup {} {
|
||||
if {!$::quiet} {puts "OK"}
|
||||
}
|
||||
|
||||
proc find_available_port start {
|
||||
for {set j $start} {$j < $start+1024} {incr j} {
|
||||
if {[catch {
|
||||
set fd [socket 127.0.0.1 $j]
|
||||
}]} {
|
||||
return $j
|
||||
} else {
|
||||
close $fd
|
||||
}
|
||||
}
|
||||
if {$j == $start+1024} {
|
||||
error "Can't find a non busy port in the $start-[expr {$start+1023}] range."
|
||||
}
|
||||
}
|
||||
|
||||
proc test_server_main {} {
|
||||
cleanup
|
||||
set tclsh [info nameofexecutable]
|
||||
|
Loading…
x
Reference in New Issue
Block a user