changed how server.tcl accepts options to support more directives without requiring more arguments to the proc

This commit is contained in:
Pieter Noordhuis 2010-06-02 22:23:52 +02:00
parent 38273a9ed6
commit 9e5d2e8bd6
14 changed files with 30 additions and 19 deletions

View File

@ -17,7 +17,7 @@ proc create_aof {code} {
proc start_server_aof {overrides code} { proc start_server_aof {overrides code} {
upvar defaults defaults srv srv server_path server_path upvar defaults defaults srv srv server_path server_path
set _defaults $defaults set _defaults $defaults
set srv [start_server default.conf [lappend _defaults $overrides]] set srv [start_server {overrides [lappend _defaults $overrides]}]
uplevel 1 $code uplevel 1 $code
kill_server $srv kill_server $srv
} }

View File

@ -1,7 +1,7 @@
start_server default.conf {} { start_server {} {
r set mykey foo r set mykey foo
start_server default.conf {} { start_server {} {
test {Second server should have role master at first} { test {Second server should have role master at first} {
s role s role
} {master} } {master}

View File

@ -81,8 +81,21 @@ proc ping_server {host port} {
} }
set ::global_overrides {} set ::global_overrides {}
proc start_server {filename overrides {code undefined}} { proc start_server {options {code undefined}} {
set data [split [exec cat "tests/assets/$filename"] "\n"] # setup defaults
set baseconfig "default.conf"
set overrides {}
# parse options
foreach {option value} $options {
switch $option {
"config" { set baseconfig $value }
"overrides" { set overrides $value }
default { error "Unknown option $option" }
}
}
set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
set config {} set config {}
foreach line $data { foreach line $data {
if {[string length $line] > 0 && [string index $line 0] ne "#"} { if {[string length $line] > 0 && [string index $line 0] ne "#"} {
@ -100,9 +113,7 @@ proc start_server {filename overrides {code undefined}} {
dict set config port [incr ::port] dict set config port [incr ::port]
# apply overrides from global space and arguments # apply overrides from global space and arguments
foreach override [concat $::global_overrides $overrides] { foreach {directive arguments} [concat $::global_overrides $overrides] {
set directive [lrange $override 0 0]
set arguments [lrange $override 1 end]
dict set config $directive $arguments dict set config $directive $arguments
} }

View File

@ -1,4 +1,4 @@
start_server default.conf {{requirepass foobar}} { start_server {overrides {requirepass foobar}} {
test {AUTH fails when a wrong password is given} { test {AUTH fails when a wrong password is given} {
catch {r auth wrong!} err catch {r auth wrong!} err
format $err format $err

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {DEL all keys to start with a clean DB} { test {DEL all keys to start with a clean DB} {
foreach key [r keys *] {r del $key} foreach key [r keys *] {r del $key}
r dbsize r dbsize

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {EXEC works on WATCHed key not modified} { test {EXEC works on WATCHed key not modified} {
r watch x y z r watch x y z
r watch k r watch k

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {EXPIRE - don't set timeouts multiple times} { test {EXPIRE - don't set timeouts multiple times} {
r set x foobar r set x foobar
set v1 [r expire x 5] set v1 [r expire x 5]

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {SAVE - make sure there are all the types as values} { test {SAVE - make sure there are all the types as values} {
# Wait for a background saving in progress to terminate # Wait for a background saving in progress to terminate
waitForBgsave r waitForBgsave r

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {Handle an empty query well} { test {Handle an empty query well} {
set fd [r channel] set fd [r channel]
puts -nonewline $fd "\r\n" puts -nonewline $fd "\r\n"

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {SORT ALPHA against integer encoded strings} { test {SORT ALPHA against integer encoded strings} {
r del mylist r del mylist
r lpush mylist 2 r lpush mylist 2

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {HSET/HLEN - Small hash creation} { test {HSET/HLEN - Small hash creation} {
array set smallhash {} array set smallhash {}
for {set i 0} {$i < 8} {incr i} { for {set i 0} {$i < 8} {incr i} {

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} { test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
set res [r lpush mylist a] set res [r lpush mylist a]
append res [r lpush mylist b] append res [r lpush mylist b]

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {SADD, SCARD, SISMEMBER, SMEMBERS basics} { test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
r sadd myset foo r sadd myset foo
r sadd myset bar r sadd myset bar

View File

@ -1,4 +1,4 @@
start_server default.conf {} { start_server {} {
test {ZSET basic ZADD and score update} { test {ZSET basic ZADD and score update} {
r zadd ztmp 10 x r zadd ztmp 10 x
r zadd ztmp 20 y r zadd ztmp 20 y