Commit c4669d25 authored by antirez's avatar antirez
Browse files

tests suite initial support for valgrind, fixed the old test suite until the...

tests suite initial support for valgrind, fixed the old test suite until the new one is able to target a specific host/port
parent 10dea8dc
......@@ -4,7 +4,7 @@
# more information.
set tcl_precision 17
source redis.tcl
source tests/support/redis.tcl
set ::passed 0
set ::failed 0
......
......@@ -7,6 +7,20 @@ proc error_and_quit {config_file error} {
exit 1
}
proc check_valgrind_errors stderr {
set fd [open $stderr]
set buf [read $fd]
close $fd
if {![regexp -- {ERROR SUMMARY: 0 errors} $buf] ||
![regexp -- {definitely lost: 0 bytes} $buf]} {
puts "*** VALGRIND ERRORS ***"
puts $buf
puts "--- press enter to continue ---"
gets stdin
}
}
proc kill_server config {
# nevermind if its already dead
if {![is_alive $config]} { return }
......@@ -29,6 +43,11 @@ proc kill_server config {
catch {exec kill $pid}
after 10
}
# Check valgrind errors if needed
if {$::valgrind} {
check_valgrind_errors [dict get $config stderr]
}
}
proc is_alive config {
......@@ -40,6 +59,25 @@ proc is_alive config {
}
}
proc ping_server {host port} {
set retval 0
if {[catch {
set fd [socket $::host $::port]
fconfigure $fd -translation binary
puts $fd "PING\r\n"
flush $fd
set reply [gets $fd]
if {[string range $reply 0 4] eq {+PONG} ||
[string range $reply 0 3] eq {-ERR}} {
set retval 1
}
close $fd
} e]} {
puts "Can't PING server at $host:$port... $e"
}
return $retval
}
set ::global_overrides {}
proc start_server {filename overrides {code undefined}} {
set data [split [exec cat "tests/assets/$filename"] "\n"]
......@@ -77,16 +115,25 @@ proc start_server {filename overrides {code undefined}} {
set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
if {$::valgrind} {
exec valgrind --leak-check=full ./redis-server $config_file > $stdout 2> $stderr &
after 2000
} else {
exec ./redis-server $config_file > $stdout 2> $stderr &
after 500
}
# check that the server actually started
if {[file size $stderr] > 0} {
if {$code ne "undefined" && ![ping_server $::host $::port]} {
error_and_quit $config_file [exec cat $stderr]
}
# find out the pid
while {![info exists pid]} {
regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid
after 100
}
# setup properties to be able to initialize a client object
set host $::host
......
......@@ -12,6 +12,7 @@ source tests/support/util.tcl
set ::host 127.0.0.1
set ::port 16379
set ::traceleaks 0
set ::valgrind 0
proc execute_tests name {
set cur $::testnum
......@@ -50,8 +51,8 @@ proc s {args} {
}
proc cleanup {} {
exec rm -rf {*}[glob tests/tmp/redis.conf.*]
exec rm -rf {*}[glob tests/tmp/server.*]
catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]}
catch {exec rm -rf {*}[glob tests/tmp/server.*]}
}
proc main {} {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment