X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/436f18b618d3820ee3c99b2ae78cf29bf36b2994..bb8716b6dc6980415da8b40b46ffb6e637f33a6c:/tests/support/server.tcl diff --git a/tests/support/server.tcl b/tests/support/server.tcl index 750d799a..8e226a7d 100644 --- a/tests/support/server.tcl +++ b/tests/support/server.tcl @@ -1,3 +1,6 @@ +set ::global_overrides {} +set ::tags {} + proc error_and_quit {config_file error} { puts "!!COULD NOT START REDIS-SERVER\n" puts "CONFIGURATION:" @@ -22,6 +25,9 @@ proc check_valgrind_errors stderr { } proc kill_server config { + # nothing to kill when running against external server + if {$::external} return + # nevermind if its already dead if {![is_alive $config]} { return } set pid [dict get $config pid] @@ -30,9 +36,11 @@ proc kill_server config { if {![dict exists $config "skipleaks"]} { catch { if {[string match {*Darwin*} [exec uname -a]]} { - test "Check for memory leaks (pid $pid)" { - exec leaks $pid - } {*0 leaks*} + tags {"leaks"} { + test "Check for memory leaks (pid $pid)" { + exec leaks $pid + } {*0 leaks*} + } } } } @@ -80,9 +88,53 @@ proc ping_server {host port} { return $retval } -set ::global_overrides {} -proc start_server {filename overrides {code undefined}} { - set data [split [exec cat "tests/assets/$filename"] "\n"] +# doesn't really belong here, but highly coupled to code in start_server +proc tags {tags code} { + set ::tags [concat $::tags $tags] + uplevel 1 $code + set ::tags [lrange $::tags 0 end-[llength $tags]] +} + +proc start_server {options {code undefined}} { + # If we are runnign against an external server, we just push the + # host/port pair in the stack the first time + if {$::external} { + if {[llength $::servers] == 0} { + set srv {} + dict set srv "host" $::host + dict set srv "port" $::port + set client [redis $::host $::port] + dict set srv "client" $client + $client select 9 + + # append the server to the stack + lappend ::servers $srv + } + uplevel 1 $code + return + } + + # setup defaults + set baseconfig "default.conf" + set overrides {} + set tags {} + + # parse options + foreach {option value} $options { + switch $option { + "config" { + set baseconfig $value } + "overrides" { + set overrides $value } + "tags" { + set tags $value + set ::tags [concat $::tags $value] } + default { + error "Unknown option $option" } + } + } + + set data [split [exec cat "tests/assets/$baseconfig"] "\n"] set config {} foreach line $data { if {[string length $line] > 0 && [string index $line 0] ne "#"} { @@ -100,9 +152,7 @@ proc start_server {filename overrides {code undefined}} { dict set config port [incr ::port] # apply overrides from global space and arguments - foreach override [concat $::global_overrides $overrides] { - set directive [lrange $override 0 0] - set arguments [lrange $override 1 end] + foreach {directive arguments} [concat $::global_overrides $overrides] { dict set config $directive $arguments } @@ -119,10 +169,10 @@ proc start_server {filename overrides {code undefined}} { set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] if {$::valgrind} { - exec valgrind ./redis-server $config_file > $stdout 2> $stderr & + exec valgrind src/redis-server $config_file > $stdout 2> $stderr & after 2000 } else { - exec ./redis-server $config_file > $stdout 2> $stderr & + exec src/redis-server $config_file > $stdout 2> $stderr & after 500 } @@ -179,7 +229,12 @@ proc start_server {filename overrides {code undefined}} { lappend ::servers $srv # execute provided block + set curnum $::testnum catch { uplevel 1 $code } err + if {$curnum == $::testnum} { + # don't check for leaks when no tests were executed + dict set srv "skipleaks" 1 + } # pop the server object set ::servers [lrange $::servers 0 end-1] @@ -204,8 +259,10 @@ proc start_server {filename overrides {code undefined}} { exit 1 } + set ::tags [lrange $::tags 0 end-[llength $tags]] kill_server $srv } else { + set ::tags [lrange $::tags 0 end-[llength $tags]] set _ $srv } }