Merge branch 'integration' of git://github.com/pietern/redis

tests/integration/replication.tcl

@@ -0,0 +1,32 @@
+start_server default.conf {} {
+    r set mykey foo
+    
+    start_server default.conf {} {
+        test {Second server should have role master at first} {
+            s role
+        } {master}
+        
+        test {SLAVEOF should start with link status "down"} {
+            r slaveof [srv -1 host] [srv -1 port]
+            s master_link_status
+        } {down}
+        
+        test {The role should immediately be changed to "slave"} {
+            s role
+        } {slave}
+
+        wait_for_sync r
+        test {Sync should have transferred keys from master} {
+            r get mykey
+        } {foo}
+        
+        test {The link status should be up} {
+            s master_link_status
+        } {up}
+        
+        test {SET on the master should immediately propagate} {
+            r -1 set mykey bar
+            r  0 get mykey
+        } {bar}
+    }
+}

tests/support/server.tcl

@@ -103,23 +103,25 @@ proc start_server {filename overrides {code undefined}} {
     }
 
     # setup config dict
-    dict set ret "config" $config_file
+    dict set srv "config" $config_file
-    dict set ret "pid" $pid
+    dict set srv "pid" $pid
-    dict set ret "stdout" $stdout
+    dict set srv "host" $host
-    dict set ret "stderr" $stderr
+    dict set srv "port" $port
-    dict set ret "client" $client
+    dict set srv "stdout" $stdout
+    dict set srv "stderr" $stderr
+    dict set srv "client" $client
 
     if {$code ne "undefined"} {
-        # append the client to the client stack
+        # append the server to the stack
-        lappend ::clients $client
+        lappend ::servers $srv
         
         # execute provided block
         catch { uplevel 1 $code } err
 
-        # pop the client object
+        # pop the server object
-        set ::clients [lrange $::clients 0 end-1]
+        set ::servers [lrange $::servers 0 end-1]
         
-        kill_server $ret
+        kill_server $srv
 
         if {[string length $err] > 0} {
             puts "Error executing the suite, aborting..."
@@ -127,6 +129,6 @@ proc start_server {filename overrides {code undefined}} {
             exit 1
         }
     } else {
-        set _ $ret
+        set _ $srv
     }
 }

tests/support/util.tcl

@@ -25,10 +25,16 @@ proc zlistAlikeSort {a b} {
     string compare [lindex $a 1] [lindex $b 1]
 }
 
+# Return value for INFO property
+proc status {r property} {
+    if {[regexp "\r\n$property:(.*?)\r\n" [$r info] _ value]} {
+        set _ $value
+    }
+}
+
 proc waitForBgsave r {
     while 1 {
-        set i [$r info]
+        if {[status r bgsave_in_progress] eq 1} {
-        if {[string match {*bgsave_in_progress:1*} $i]} {
             puts -nonewline "\nWaiting for background save to finish... "
             flush stdout
             after 1000
@@ -40,8 +46,7 @@ proc waitForBgsave r {
 
 proc waitForBgrewriteaof r {
     while 1 {
-        set i [$r info]
+        if {[status r bgrewriteaof_in_progress] eq 1} {
-        if {[string match {*bgrewriteaof_in_progress:1*} $i]} {
             puts -nonewline "\nWaiting for background AOF rewrite to finish... "
             flush stdout
             after 1000
@@ -51,6 +56,16 @@ proc waitForBgrewriteaof r {
     }
 }
 
+proc wait_for_sync r {
+    while 1 {
+        if {[status r master_link_status] eq "down"} {
+            after 10
+        } else {
+            break
+        }
+    }
+}
+
 proc randomInt {max} {
     expr {int(rand()*$max)}
 }

tests/test_helper.tcl

@@ -18,12 +18,35 @@ proc execute_tests name {
     source "tests/$name.tcl"
 }
 
-# setup a list to hold a stack of clients. the proc "r" provides easy
+# Setup a list to hold a stack of server configs. When calls to start_server
-# access to the client at the top of the stack
+# are nested, use "srv 0 pid" to get the pid of the inner server. To access
-set ::clients {}
+# outer servers, use "srv -1 pid" etcetera.
+set ::servers {}
+proc srv {level property} {
+    set srv [lindex $::servers end+$level]
+    dict get $srv $property
+}
+
+# Provide easy access to the client for the inner server. It's possible to
+# prepend the argument list with a negative level to access clients for
+# servers running in outer blocks.
 proc r {args} {
-    set client [lindex $::clients end]
+    set level 0
-    $client {*}$args
+    if {[string is integer [lindex $args 0]]} {
+        set level [lindex $args 0]
+        set args [lrange $args 1 end]
+    }
+    [srv $level "client"] {*}$args
+}
+
+# Provide easy access to INFO properties. Same semantic as "proc r".
+proc s {args} {
+    set level 0
+    if {[string is integer [lindex $args 0]]} {
+        set level [lindex $args 0]
+        set args [lrange $args 1 end]
+    }
+    status [srv $level "client"] [lindex $args 0]
 }
 
 proc main {} {
@@ -37,6 +60,7 @@ proc main {} {
     execute_tests "unit/sort"
     execute_tests "unit/expire"
     execute_tests "unit/other"
+    execute_tests "integration/replication"
     
     puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
     if {$::failed > 0} {