proc error_and_quit {config_file error} { puts "!!COULD NOT START REDIS-SERVER\n" puts "CONFIGURATION:" puts [exec cat $config_file] puts "\nERROR:" puts [string trim $error] exit 1 } proc kill_server config { set pid [dict get $config pid] # check for leaks catch { if {[string match {*Darwin*} [exec uname -a]]} { test {Check for memory leaks} { exec leaks $pid } {*0 leaks*} } } # kill server and wait for the process to be totally exited exec kill $pid while 1 { # with a non-zero exit status, the process is gone if {[catch {exec ps -p $pid | grep redis-server} result]} { break } after 10 } } proc start_server {filename overrides {code undefined}} { set data [split [exec cat "test/assets/$filename"] "\n"] set config {} foreach line $data { if {[string length $line] > 0 && [string index $line 0] ne "#"} { set elements [split $line " "] set directive [lrange $elements 0 0] set arguments [lrange $elements 1 end] dict set config $directive $arguments } } # use a different directory every time a server is started dict set config dir [tmpdir server] # start every server on a different port dict set config port [incr ::port] # apply overrides from arguments foreach override $overrides { set directive [lrange $override 0 0] set arguments [lrange $override 1 end] dict set config $directive $arguments } # write new configuration to temporary file set config_file [tmpfile redis.conf] set fp [open $config_file w+] foreach directive [dict keys $config] { puts -nonewline $fp "$directive " puts $fp [dict get $config $directive] } close $fp set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] exec ./redis-server $config_file > $stdout 2> $stderr & after 10 # check that the server actually started if {[file size $stderr] > 0} { error_and_quit $config_file [exec cat $stderr] } set line [exec head -n1 $stdout] if {[string match {*already in use*} $line]} { error_and_quit $config_file $line } while 1 { # check that the server actually started and is ready for connections if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} { break } after 10 } # find out the pid regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid # create the client object set host $::host set port $::port if {[dict exists $config bind]} { set host [dict get $config bind] } if {[dict exists $config port]} { set port [dict get $config port] } set client [redis $host $port] # select the right db when we don't have to authenticate if {![dict exists $config requirepass]} { $client select 9 } # setup config dict dict set ret "config" $config_file dict set ret "pid" $pid dict set ret "stdout" $stdout dict set ret "stderr" $stderr dict set ret "client" $client if {$code ne "undefined"} { # append the client to the client stack lappend ::clients $client # execute provided block catch { uplevel 1 $code } err # pop the client object set ::clients [lrange $::clients 0 end-1] kill_server $ret if {[string length $err] > 0} { puts "Error executing the suite, aborting..." puts $err exit 1 } } else { set _ $ret } }