1proc error_and_quit {config_file error} { 2 puts "!!COULD NOT START REDIS-SERVER\n" 3 puts "CONFIGURATION:" 4 puts [exec cat $config_file] 5 puts "\nERROR:" 6 puts [string trim $error] 7 exit 1 8} 9 10proc kill_server config { 11 # nevermind if its already dead 12 if {![is_alive $config]} { return } 13 set pid [dict get $config pid] 14 15 # check for leaks 16 catch { 17 if {[string match {*Darwin*} [exec uname -a]]} { 18 test "Check for memory leaks (pid $pid)" { 19 exec leaks $pid 20 } {*0 leaks*} 21 } 22 } 23 24 # kill server and wait for the process to be totally exited 25 while {[is_alive $config]} { 26 if {[incr wait 10] % 1000 == 0} { 27 puts "Waiting for process $pid to exit..." 28 } 29 catch {exec kill $pid} 30 after 10 31 } 32} 33 34proc is_alive config { 35 set pid [dict get $config pid] 36 if {[catch {exec ps -p $pid} err]} { 37 return 0 38 } else { 39 return 1 40 } 41} 42 43set ::global_overrides {} 44proc start_server {filename overrides {code undefined}} { 45 set data [split [exec cat "tests/assets/$filename"] "\n"] 46 set config {} 47 foreach line $data { 48 if {[string length $line] > 0 && [string index $line 0] ne "#"} { 49 set elements [split $line " "] 50 set directive [lrange $elements 0 0] 51 set arguments [lrange $elements 1 end] 52 dict set config $directive $arguments 53 } 54 } 55 56 # use a different directory every time a server is started 57 dict set config dir [tmpdir server] 58 59 # start every server on a different port 60 dict set config port [incr ::port] 61 62 # apply overrides from global space and arguments 63 foreach override [concat $::global_overrides $overrides] { 64 set directive [lrange $override 0 0] 65 set arguments [lrange $override 1 end] 66 dict set config $directive $arguments 67 } 68 69 # write new configuration to temporary file 70 set config_file [tmpfile redis.conf] 71 set fp [open $config_file w+] 72 foreach directive [dict keys $config] { 73 puts -nonewline $fp "$directive " 74 puts $fp [dict get $config $directive] 75 } 76 close $fp 77 78 set stdout [format "%s/%s" [dict get $config "dir"] "stdout"] 79 set stderr [format "%s/%s" [dict get $config "dir"] "stderr"] 80 exec ./redis-server $config_file > $stdout 2> $stderr & 81 after 500 82 83 # check that the server actually started 84 if {[file size $stderr] > 0} { 85 error_and_quit $config_file [exec cat $stderr] 86 } 87 88 # find out the pid 89 regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid 90 91 # setup properties to be able to initialize a client object 92 set host $::host 93 set port $::port 94 if {[dict exists $config bind]} { set host [dict get $config bind] } 95 if {[dict exists $config port]} { set port [dict get $config port] } 96 97 # setup config dict 98 dict set srv "config" $config_file 99 dict set srv "pid" $pid 100 dict set srv "host" $host 101 dict set srv "port" $port 102 dict set srv "stdout" $stdout 103 dict set srv "stderr" $stderr 104 105 # if a block of code is supplied, we wait for the server to become 106 # available, create a client object and kill the server afterwards 107 if {$code ne "undefined"} { 108 set line [exec head -n1 $stdout] 109 if {[string match {*already in use*} $line]} { 110 error_and_quit $config_file $line 111 } 112 113 while 1 { 114 # check that the server actually started and is ready for connections 115 if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} { 116 break 117 } 118 after 10 119 } 120 121 set client [redis $host $port] 122 dict set srv "client" $client 123 124 # select the right db when we don't have to authenticate 125 if {![dict exists $config requirepass]} { 126 $client select 9 127 } 128 129 # append the server to the stack 130 lappend ::servers $srv 131 132 # execute provided block 133 catch { uplevel 1 $code } err 134 135 # pop the server object 136 set ::servers [lrange $::servers 0 end-1] 137 138 kill_server $srv 139 140 if {[string length $err] > 0} { 141 puts "Error executing the suite, aborting..." 142 puts $err 143 exit 1 144 } 145 } else { 146 set _ $srv 147 } 148} 149