Permalink
Browse files

changed how server.tcl accepts options to support more directives wit…

…hout requiring more arguments to the proc
  • Loading branch information...
pietern committed Jun 2, 2010
1 parent f7b8ff2 commit c80ba6917369d0d3b677e166fed72a0ad540ddf0
@@ -17,7 +17,7 @@ proc create_aof {code} {
proc start_server_aof {overrides code} {
upvar defaults defaults srv srv server_path server_path
set _defaults $defaults
- set srv [start_server default.conf [lappend _defaults $overrides]]
+ set srv [start_server {overrides [lappend _defaults $overrides]}]
uplevel 1 $code
kill_server $srv
}
@@ -1,7 +1,7 @@
-start_server default.conf {} {
+start_server {} {
r set mykey foo
- start_server default.conf {} {
+ start_server {} {
test {Second server should have role master at first} {
s role
} {master}
View
@@ -81,8 +81,21 @@ proc ping_server {host port} {
}
set ::global_overrides {}
-proc start_server {filename overrides {code undefined}} {
- set data [split [exec cat "tests/assets/$filename"] "\n"]
+proc start_server {options {code undefined}} {
+ # 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 {}
foreach line $data {
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]
# 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
}
View
@@ -1,4 +1,4 @@
-start_server default.conf {{requirepass foobar}} {
+start_server {overrides {requirepass foobar}} {
test {AUTH fails when a wrong password is given} {
catch {r auth wrong!} err
format $err
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {DEL all keys to start with a clean DB} {
foreach key [r keys *] {r del $key}
r dbsize
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {EXPIRE - don't set timeouts multiple times} {
r set x foobar
set v1 [r expire x 5]
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {SAVE - make sure there are all the types as values} {
# Wait for a background saving in progress to terminate
waitForBgsave r
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {Handle an empty query well} {
set fd [r channel]
puts -nonewline $fd "\r\n"
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {SORT ALPHA against integer encoded strings} {
r del mylist
r lpush mylist 2
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {HSET/HLEN - Small hash creation} {
array set smallhash {}
for {set i 0} {$i < 8} {incr i} {
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} {
set res [r lpush mylist a]
append res [r lpush mylist b]
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {SADD, SCARD, SISMEMBER, SMEMBERS basics} {
r sadd myset foo
r sadd myset bar
View
@@ -1,4 +1,4 @@
-start_server default.conf {} {
+start_server {} {
test {ZSET basic ZADD and score update} {
r zadd ztmp 10 x
r zadd ztmp 20 y

0 comments on commit c80ba69

Please sign in to comment.