Merge remote branch 'pietern/2.0.0-bpop' into 2.0.0

redis.c

@@ -7712,9 +7712,20 @@ static int handleClientsWaitingListPush(redisClient *c, robj *key, robj *ele) {
 /* Blocking RPOP/LPOP */
 static void blockingPopGenericCommand(redisClient *c, int where) {
     robj *o;
+    long long lltimeout;
     time_t timeout;
     int j;
 
+    /* Make sure timeout is an integer value */
+    if (getLongLongFromObjectOrReply(c,c->argv[c->argc-1],&lltimeout,
+            "timeout is not an integer") != REDIS_OK) return;
+
+    /* Make sure the timeout is not negative */
+    if (lltimeout < 0) {
+        addReplySds(c,sdsnew("-ERR timeout is negative\r\n"));
+        return;
+    }
+
     for (j = 1; j < c->argc-1; j++) {
         o = lookupKeyWrite(c->db,c->argv[j]);
         if (o != NULL) {
@@ -7763,7 +7774,7 @@ static void blockingPopGenericCommand(redisClient *c, int where) {
     }
 
     /* If the list is empty or the key does not exists we must block */
-    timeout = strtol(c->argv[c->argc-1]->ptr,NULL,10);
+    timeout = lltimeout;
     if (timeout > 0) timeout += time(NULL);
     blockForKeys(c,c->argv+1,c->argc-2,timeout);
 }

tests/support/redis.tcl

@@ -32,6 +32,7 @@ namespace eval redis {}
 set ::redis::id 0
 array set ::redis::fd {}
 array set ::redis::blocking {}
+array set ::redis::deferred {}
 array set ::redis::callback {}
 array set ::redis::state {} ;# State in non-blocking reply reading
 array set ::redis::statestack {} ;# Stack of states, for nested mbulks
@@ -55,12 +56,13 @@ foreach redis_multibulk_cmd {
 unset redis_bulk_cmd
 unset redis_multibulk_cmd
 
-proc redis {{server 127.0.0.1} {port 6379}} {
+proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
     set fd [socket $server $port]
     fconfigure $fd -translation binary
     set id [incr ::redis::id]
     set ::redis::fd($id) $fd
     set ::redis::blocking($id) 1
+    set ::redis::deferred($id) $defer
     ::redis::redis_reset_state $id
     interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id
 }
@@ -68,6 +70,7 @@ proc redis {{server 127.0.0.1} {port 6379}} {
 proc ::redis::__dispatch__ {id method args} {
     set fd $::redis::fd($id)
     set blocking $::redis::blocking($id)
+    set deferred $::redis::deferred($id)
     if {$blocking == 0} {
         if {[llength $args] == 0} {
             error "Please provide a callback in non-blocking mode"
@@ -95,6 +98,7 @@ proc ::redis::__dispatch__ {id method args} {
             append cmd [join $args]
             ::redis::redis_writenl $fd $cmd
         }
+        if {!$deferred} {
             if {$blocking} {
                 ::redis::redis_read_reply $fd
             } else {
@@ -104,6 +108,7 @@ proc ::redis::__dispatch__ {id method args} {
                 lappend ::redis::callback($id) $callback
                 fileevent $fd readable [list ::redis::redis_readable $fd $id]
             }
+        }
     } else {
         uplevel 1 [list ::redis::__method__$method $id $fd] $args
     }
@@ -114,6 +119,10 @@ proc ::redis::__method__blocking {id fd val} {
     fconfigure $fd -blocking $val
 }
 
+proc ::redis::__method__read {id fd} {
+    ::redis::redis_read_reply $fd
+}
+
 proc ::redis::__method__close {id fd} {
     catch {close $fd}
     catch {unset ::redis::fd($id)}

tests/test_helper.tcl

@@ -41,6 +41,22 @@ proc r {args} {
     [srv $level "client"] {*}$args
 }
 
+proc redis_deferring_client {args} {
+    set level 0
+    if {[llength $args] > 0 && [string is integer [lindex $args 0]]} {
+        set level [lindex $args 0]
+        set args [lrange $args 1 end]
+    }
+
+    # create client that defers reading reply
+    set client [redis [srv $level "host"] [srv $level "port"] 1]
+
+    # select the right db and read the response (OK)
+    $client select 9
+    $client read
+    return $client
+}
+
 # Provide easy access to INFO properties. Same semantic as "proc r".
 proc s {args} {
     set level 0

tests/unit/type/list.tcl

@@ -20,6 +20,124 @@ start_server {tags {"list"}} {
         r exists mylist
     } {0}
 
+    proc create_list {key entries} {
+        r del $key
+        foreach entry $entries { r rpush $key $entry }
+    }
+
+    test "BLPOP, BRPOP: single existing list" {
+        set rd [redis_deferring_client]
+        create_list blist {a b c d}
+
+        $rd blpop blist 1
+        assert_equal {blist a} [$rd read]
+        $rd brpop blist 1
+        assert_equal {blist d} [$rd read]
+
+        $rd blpop blist 1
+        assert_equal {blist b} [$rd read]
+        $rd brpop blist 1
+        assert_equal {blist c} [$rd read]
+    }
+
+    test "BLPOP, BRPOP: multiple existing lists" {
+        set rd [redis_deferring_client]
+        create_list blist1 {a b c}
+        create_list blist2 {d e f}
+
+        $rd blpop blist1 blist2 1
+        assert_equal {blist1 a} [$rd read]
+        $rd brpop blist1 blist2 1
+        assert_equal {blist1 c} [$rd read]
+        assert_equal 1 [r llen blist1]
+        assert_equal 3 [r llen blist2]
+
+        $rd blpop blist2 blist1 1
+        assert_equal {blist2 d} [$rd read]
+        $rd brpop blist2 blist1 1
+        assert_equal {blist2 f} [$rd read]
+        assert_equal 1 [r llen blist1]
+        assert_equal 1 [r llen blist2]
+    }
+
+    test "BLPOP, BRPOP: second list has an entry" {
+        set rd [redis_deferring_client]
+        r del blist1
+        create_list blist2 {d e f}
+
+        $rd blpop blist1 blist2 1
+        assert_equal {blist2 d} [$rd read]
+        $rd brpop blist1 blist2 1
+        assert_equal {blist2 f} [$rd read]
+        assert_equal 0 [r llen blist1]
+        assert_equal 1 [r llen blist2]
+    }
+
+    foreach {pop} {BLPOP BRPOP} {
+        test "$pop: with single empty list argument" {
+            set rd [redis_deferring_client]
+            r del blist1
+            $rd $pop blist1 1
+            r rpush blist1 foo
+            assert_equal {blist1 foo} [$rd read]
+            assert_equal 0 [r exists blist1]
+        }
+
+        test "$pop: with negative timeout" {
+            set rd [redis_deferring_client]
+            $rd $pop blist1 -1
+            assert_error "ERR*is negative*" {$rd read}
+        }
+
+        test "$pop: with non-integer timeout" {
+            set rd [redis_deferring_client]
+            $rd $pop blist1 1.1
+            assert_error "ERR*not an integer*" {$rd read}
+        }
+
+        test "$pop: with zero timeout should block indefinitely" {
+            # To test this, use a timeout of 0 and wait a second.
+            # The blocking pop should still be waiting for a push.
+            set rd [redis_deferring_client]
+            $rd $pop blist1 0
+            after 1000
+            r rpush blist1 foo
+            assert_equal {blist1 foo} [$rd read]
+        }
+
+        test "$pop: second argument is not a list" {
+            set rd [redis_deferring_client]
+            r del blist1 blist2
+            r set blist2 nolist
+            $rd $pop blist1 blist2 1
+            assert_error "ERR*wrong kind*" {$rd read}
+        }
+
+        test "$pop: timeout" {
+            set rd [redis_deferring_client]
+            r del blist1 blist2
+            $rd $pop blist1 blist2 1
+            assert_equal {} [$rd read]
+        }
+
+        test "$pop: arguments are empty" {
+            set rd [redis_deferring_client]
+            r del blist1 blist2
+
+            $rd $pop blist1 blist2 1
+            r rpush blist1 foo
+            assert_equal {blist1 foo} [$rd read]
+            assert_equal 0 [r exists blist1]
+            assert_equal 0 [r exists blist2]
+
+            $rd $pop blist1 blist2 1
+            r rpush blist2 foo
+            assert_equal {blist2 foo} [$rd read]
+            assert_equal 0 [r exists blist1]
+            assert_equal 0 [r exists blist2]
+        }
+    }
+
     test {Create a long list and check every single element with LINDEX} {
         set ok 0
         for {set i 0} {$i < 1000} {incr i} {