From: Pieter Noordhuis Date: Tue, 15 Jun 2010 19:16:27 +0000 (+0200) Subject: tests for BLPOP/BRPOP via an option in the tcl client that defers reading the reply X-Git-Url: https://git.saurik.com/redis.git/commitdiff_plain/5eedc9c65e9d525f0e78c67f750e4d86d98aa097 tests for BLPOP/BRPOP via an option in the tcl client that defers reading the reply --- diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl index 8f7d7711..338dcf77 100644 --- a/tests/support/redis.tcl +++ b/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,14 +98,16 @@ proc ::redis::__dispatch__ {id method args} { append cmd [join $args] ::redis::redis_writenl $fd $cmd } - if {$blocking} { - ::redis::redis_read_reply $fd - } else { - # Every well formed reply read will pop an element from this - # list and use it as a callback. So pipelining is supported - # in non blocking mode. - lappend ::redis::callback($id) $callback - fileevent $fd readable [list ::redis::redis_readable $fd $id] + if {!$deferred} { + if {$blocking} { + ::redis::redis_read_reply $fd + } else { + # Every well formed reply read will pop an element from this + # list and use it as a callback. So pipelining is supported + # in non blocking mode. + 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)} diff --git a/tests/support/test.tcl b/tests/support/test.tcl index 988189bf..8849c9d6 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -17,7 +17,7 @@ proc assert_equal {expected value} { } proc assert_error {pattern code} { - if {[catch $code error]} { + if {[catch {uplevel 1 $code} error]} { assert_match $pattern $error } else { puts "!! ERROR\nExpected an error but nothing was catched" diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index da6520a3..dac91bef 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -42,6 +42,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 diff --git a/tests/unit/type/list.tcl b/tests/unit/type/list.tcl index ecae5d22..498cdfbb 100644 --- a/tests/unit/type/list.tcl +++ b/tests/unit/type/list.tcl @@ -78,6 +78,99 @@ start_server { assert_encoding linkedlist $key } + foreach type {ziplist linkedlist} { + test "BLPOP, BRPOP: single existing list - $type" { + set rd [redis_deferring_client] + create_$type 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 - $type" { + set rd [redis_deferring_client] + create_$type blist1 {a b c} + create_$type 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 - $type" { + set rd [redis_deferring_client] + r del blist1 + create_$type 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: 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 {LPUSHX, RPUSHX - generic} { r del xlist assert_equal 0 [r lpushx xlist a]