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} {
|
proc ping_server {host port} {
|
||||||
set retval 0
|
set retval 0
|
||||||
if {[catch {
|
if {[catch {
|
||||||
set fd [socket $::host $::port]
|
set fd [socket $host $port]
|
||||||
fconfigure $fd -translation binary
|
fconfigure $fd -translation binary
|
||||||
puts $fd "PING\r\n"
|
puts $fd "PING\r\n"
|
||||||
flush $fd
|
flush $fd
|
||||||
@ -101,6 +101,22 @@ proc ping_server {host port} {
|
|||||||
return $retval
|
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
|
# doesn't really belong here, but highly coupled to code in start_server
|
||||||
proc tags {tags code} {
|
proc tags {tags code} {
|
||||||
set ::tags [concat $::tags $tags]
|
set ::tags [concat $::tags $tags]
|
||||||
@ -191,23 +207,13 @@ proc start_server {options {code undefined}} {
|
|||||||
# check that the server actually started
|
# check that the server actually started
|
||||||
# ugly but tries to be as fast as possible...
|
# ugly but tries to be as fast as possible...
|
||||||
if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
|
if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
|
||||||
set serverisup 0
|
|
||||||
|
|
||||||
if {$::verbose} {
|
if {$::verbose} {
|
||||||
puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
|
puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
|
||||||
}
|
}
|
||||||
|
|
||||||
after 10
|
|
||||||
if {$code ne "undefined"} {
|
if {$code ne "undefined"} {
|
||||||
while {[incr retrynum -1]} {
|
set serverisup [server_is_up $::host $::port $retrynum]
|
||||||
catch {
|
|
||||||
if {[ping_server $::host $::port]} {
|
|
||||||
set serverisup 1
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if {$serverisup} break
|
|
||||||
after 50
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
set serverisup 1
|
set serverisup 1
|
||||||
}
|
}
|
||||||
|
@ -312,3 +312,18 @@ proc csvstring s {
|
|||||||
proc roundFloat f {
|
proc roundFloat f {
|
||||||
format "%.10g" $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"}
|
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 {} {
|
proc test_server_main {} {
|
||||||
cleanup
|
cleanup
|
||||||
set tclsh [info nameofexecutable]
|
set tclsh [info nameofexecutable]
|
||||||
|
Loading…
x
Reference in New Issue
Block a user