summaryrefslogtreecommitdiff
path: root/tests/unit
diff options
context:
space:
mode:
authorbyte2016 <[email protected]>2018-06-12 19:55:38 +0800
committerbyte2016 <[email protected]>2018-06-12 19:55:38 +0800
commit76f2c13d7c27d7419af79ea0bdc7ab7717b6935b (patch)
treeaa2ca741501d40990b892d504a1cc3b7defe57aa /tests/unit
Init commit.HEADmaster
Diffstat (limited to 'tests/unit')
-rw-r--r--tests/unit/aofrw.tcl213
-rw-r--r--tests/unit/auth.tcl27
-rw-r--r--tests/unit/bitfield.tcl201
-rw-r--r--tests/unit/bitops.tcl351
-rw-r--r--tests/unit/dump.tcl311
-rw-r--r--tests/unit/expire.tcl207
-rw-r--r--tests/unit/geo.tcl308
-rw-r--r--tests/unit/hyperloglog.tcl185
-rw-r--r--tests/unit/introspection-2.tcl23
-rw-r--r--tests/unit/introspection.tcl60
-rw-r--r--tests/unit/keyspace.tcl275
-rw-r--r--tests/unit/latency-monitor.tcl50
-rw-r--r--tests/unit/lazyfree.tcl39
-rw-r--r--tests/unit/limits.tcl16
-rw-r--r--tests/unit/maxmemory.tcl144
-rw-r--r--tests/unit/memefficiency.tcl37
-rw-r--r--tests/unit/multi.tcl309
-rw-r--r--tests/unit/obuf-limits.tcl73
-rw-r--r--tests/unit/other.tcl246
-rw-r--r--tests/unit/printver.tcl6
-rw-r--r--tests/unit/protocol.tcl117
-rw-r--r--tests/unit/pubsub.tcl390
-rw-r--r--tests/unit/quit.tcl40
-rw-r--r--tests/unit/scan.tcl239
-rw-r--r--tests/unit/scripting.tcl735
-rw-r--r--tests/unit/slowlog.tcl70
-rw-r--r--tests/unit/sort.tcl318
-rw-r--r--tests/unit/type/hash.tcl536
-rw-r--r--tests/unit/type/incr.tcl147
-rw-r--r--tests/unit/type/list-2.tcl47
-rw-r--r--tests/unit/type/list-3.tcl122
-rw-r--r--tests/unit/type/list-common.tcl5
-rw-r--r--tests/unit/type/list.tcl837
-rw-r--r--tests/unit/type/set.tcl601
-rw-r--r--tests/unit/type/string.tcl422
-rw-r--r--tests/unit/type/zset.tcl1030
-rw-r--r--tests/unit/wait.tcl42
37 files changed, 8779 insertions, 0 deletions
diff --git a/tests/unit/aofrw.tcl b/tests/unit/aofrw.tcl
new file mode 100644
index 0000000..dff7588
--- /dev/null
+++ b/tests/unit/aofrw.tcl
@@ -0,0 +1,213 @@
+start_server {tags {"aofrw"}} {
+ # Enable the AOF
+ r config set appendonly yes
+ r config set auto-aof-rewrite-percentage 0 ; # Disable auto-rewrite.
+ waitForBgrewriteaof r
+
+ foreach rdbpre {yes no} {
+ r config set aof-use-rdb-preamble $rdbpre
+ test "AOF rewrite during write load: RDB preamble=$rdbpre" {
+ # Start a write load for 10 seconds
+ set master [srv 0 client]
+ set master_host [srv 0 host]
+ set master_port [srv 0 port]
+ set load_handle0 [start_write_load $master_host $master_port 10]
+ set load_handle1 [start_write_load $master_host $master_port 10]
+ set load_handle2 [start_write_load $master_host $master_port 10]
+ set load_handle3 [start_write_load $master_host $master_port 10]
+ set load_handle4 [start_write_load $master_host $master_port 10]
+
+ # Make sure the instance is really receiving data
+ wait_for_condition 50 100 {
+ [r dbsize] > 0
+ } else {
+ fail "No write load detected."
+ }
+
+ # After 3 seconds, start a rewrite, while the write load is still
+ # active.
+ after 3000
+ r bgrewriteaof
+ waitForBgrewriteaof r
+
+ # Let it run a bit more so that we'll append some data to the new
+ # AOF.
+ after 1000
+
+ # Stop the processes generating the load if they are still active
+ stop_write_load $load_handle0
+ stop_write_load $load_handle1
+ stop_write_load $load_handle2
+ stop_write_load $load_handle3
+ stop_write_load $load_handle4
+
+ # Make sure that we remain the only connected client.
+ # This step is needed to make sure there are no pending writes
+ # that will be processed between the two "debug digest" calls.
+ wait_for_condition 50 100 {
+ [llength [split [string trim [r client list]] "\n"]] == 1
+ } else {
+ puts [r client list]
+ fail "Clients generating loads are not disconnecting"
+ }
+
+ # Get the data set digest
+ set d1 [r debug digest]
+
+ # Load the AOF
+ r debug loadaof
+ set d2 [r debug digest]
+
+ # Make sure they are the same
+ assert {$d1 eq $d2}
+ }
+ }
+}
+
+start_server {tags {"aofrw"}} {
+ test {Turning off AOF kills the background writing child if any} {
+ r config set appendonly yes
+ waitForBgrewriteaof r
+ r multi
+ r bgrewriteaof
+ r config set appendonly no
+ r exec
+ wait_for_condition 50 100 {
+ [string match {*Killing*AOF*child*} [exec tail -5 < [srv 0 stdout]]]
+ } else {
+ fail "Can't find 'Killing AOF child' into recent logs"
+ }
+ }
+
+ foreach d {string int} {
+ foreach e {quicklist} {
+ test "AOF rewrite of list with $e encoding, $d data" {
+ r flushall
+ set len 1000
+ for {set j 0} {$j < $len} {incr j} {
+ if {$d eq {string}} {
+ set data [randstring 0 16 alpha]
+ } else {
+ set data [randomInt 4000000000]
+ }
+ r lpush key $data
+ }
+ assert_equal [r object encoding key] $e
+ set d1 [r debug digest]
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set d2 [r debug digest]
+ if {$d1 ne $d2} {
+ error "assertion:$d1 is not equal to $d2"
+ }
+ }
+ }
+ }
+
+ foreach d {string int} {
+ foreach e {intset hashtable} {
+ test "AOF rewrite of set with $e encoding, $d data" {
+ r flushall
+ if {$e eq {intset}} {set len 10} else {set len 1000}
+ for {set j 0} {$j < $len} {incr j} {
+ if {$d eq {string}} {
+ set data [randstring 0 16 alpha]
+ } else {
+ set data [randomInt 4000000000]
+ }
+ r sadd key $data
+ }
+ if {$d ne {string}} {
+ assert_equal [r object encoding key] $e
+ }
+ set d1 [r debug digest]
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set d2 [r debug digest]
+ if {$d1 ne $d2} {
+ error "assertion:$d1 is not equal to $d2"
+ }
+ }
+ }
+ }
+
+ foreach d {string int} {
+ foreach e {ziplist hashtable} {
+ test "AOF rewrite of hash with $e encoding, $d data" {
+ r flushall
+ if {$e eq {ziplist}} {set len 10} else {set len 1000}
+ for {set j 0} {$j < $len} {incr j} {
+ if {$d eq {string}} {
+ set data [randstring 0 16 alpha]
+ } else {
+ set data [randomInt 4000000000]
+ }
+ r hset key $data $data
+ }
+ assert_equal [r object encoding key] $e
+ set d1 [r debug digest]
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set d2 [r debug digest]
+ if {$d1 ne $d2} {
+ error "assertion:$d1 is not equal to $d2"
+ }
+ }
+ }
+ }
+
+ foreach d {string int} {
+ foreach e {ziplist skiplist} {
+ test "AOF rewrite of zset with $e encoding, $d data" {
+ r flushall
+ if {$e eq {ziplist}} {set len 10} else {set len 1000}
+ for {set j 0} {$j < $len} {incr j} {
+ if {$d eq {string}} {
+ set data [randstring 0 16 alpha]
+ } else {
+ set data [randomInt 4000000000]
+ }
+ r zadd key [expr rand()] $data
+ }
+ assert_equal [r object encoding key] $e
+ set d1 [r debug digest]
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set d2 [r debug digest]
+ if {$d1 ne $d2} {
+ error "assertion:$d1 is not equal to $d2"
+ }
+ }
+ }
+ }
+
+ test {BGREWRITEAOF is delayed if BGSAVE is in progress} {
+ r multi
+ r bgsave
+ r bgrewriteaof
+ r info persistence
+ set res [r exec]
+ assert_match {*scheduled*} [lindex $res 1]
+ assert_match {*aof_rewrite_scheduled:1*} [lindex $res 2]
+ while {[string match {*aof_rewrite_scheduled:1*} [r info persistence]]} {
+ after 100
+ }
+ }
+
+ test {BGREWRITEAOF is refused if already in progress} {
+ catch {
+ r multi
+ r bgrewriteaof
+ r bgrewriteaof
+ r exec
+ } e
+ assert_match {*ERR*already*} $e
+ while {[string match {*aof_rewrite_scheduled:1*} [r info persistence]]} {
+ after 100
+ }
+ }
+}
diff --git a/tests/unit/auth.tcl b/tests/unit/auth.tcl
new file mode 100644
index 0000000..633cda9
--- /dev/null
+++ b/tests/unit/auth.tcl
@@ -0,0 +1,27 @@
+start_server {tags {"auth"}} {
+ test {AUTH fails if there is no password configured server side} {
+ catch {r auth foo} err
+ set _ $err
+ } {ERR*no password*}
+}
+
+start_server {tags {"auth"} overrides {requirepass foobar}} {
+ test {AUTH fails when a wrong password is given} {
+ catch {r auth wrong!} err
+ set _ $err
+ } {ERR*invalid password}
+
+ test {Arbitrary command gives an error when AUTH is required} {
+ catch {r set foo bar} err
+ set _ $err
+ } {NOAUTH*}
+
+ test {AUTH succeeds when the right password is given} {
+ r auth foobar
+ } {OK}
+
+ test {Once AUTH succeeded we can actually send commands to the server} {
+ r set foo 100
+ r incr foo
+ } {101}
+}
diff --git a/tests/unit/bitfield.tcl b/tests/unit/bitfield.tcl
new file mode 100644
index 0000000..d76452b
--- /dev/null
+++ b/tests/unit/bitfield.tcl
@@ -0,0 +1,201 @@
+start_server {tags {"bitops"}} {
+ test {BITFIELD signed SET and GET basics} {
+ r del bits
+ set results {}
+ lappend results [r bitfield bits set i8 0 -100]
+ lappend results [r bitfield bits set i8 0 101]
+ lappend results [r bitfield bits get i8 0]
+ set results
+ } {0 -100 101}
+
+ test {BITFIELD unsigned SET and GET basics} {
+ r del bits
+ set results {}
+ lappend results [r bitfield bits set u8 0 255]
+ lappend results [r bitfield bits set u8 0 100]
+ lappend results [r bitfield bits get u8 0]
+ set results
+ } {0 255 100}
+
+ test {BITFIELD #<idx> form} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 65
+ r bitfield bits set u8 #1 66
+ r bitfield bits set u8 #2 67
+ r get bits
+ } {ABC}
+
+ test {BITFIELD basic INCRBY form} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 10
+ lappend results [r bitfield bits incrby u8 #0 100]
+ lappend results [r bitfield bits incrby u8 #0 100]
+ set results
+ } {110 210}
+
+ test {BITFIELD chaining of multiple commands} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 10
+ lappend results [r bitfield bits incrby u8 #0 100 incrby u8 #0 100]
+ set results
+ } {{110 210}}
+
+ test {BITFIELD unsigned overflow wrap} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 100
+ lappend results [r bitfield bits overflow wrap incrby u8 #0 257]
+ lappend results [r bitfield bits get u8 #0]
+ lappend results [r bitfield bits overflow wrap incrby u8 #0 255]
+ lappend results [r bitfield bits get u8 #0]
+ } {101 101 100 100}
+
+ test {BITFIELD unsigned overflow sat} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 100
+ lappend results [r bitfield bits overflow sat incrby u8 #0 257]
+ lappend results [r bitfield bits get u8 #0]
+ lappend results [r bitfield bits overflow sat incrby u8 #0 -255]
+ lappend results [r bitfield bits get u8 #0]
+ } {255 255 0 0}
+
+ test {BITFIELD signed overflow wrap} {
+ r del bits
+ set results {}
+ r bitfield bits set i8 #0 100
+ lappend results [r bitfield bits overflow wrap incrby i8 #0 257]
+ lappend results [r bitfield bits get i8 #0]
+ lappend results [r bitfield bits overflow wrap incrby i8 #0 255]
+ lappend results [r bitfield bits get i8 #0]
+ } {101 101 100 100}
+
+ test {BITFIELD signed overflow sat} {
+ r del bits
+ set results {}
+ r bitfield bits set u8 #0 100
+ lappend results [r bitfield bits overflow sat incrby i8 #0 257]
+ lappend results [r bitfield bits get i8 #0]
+ lappend results [r bitfield bits overflow sat incrby i8 #0 -255]
+ lappend results [r bitfield bits get i8 #0]
+ } {127 127 -128 -128}
+
+ test {BITFIELD overflow detection fuzzing} {
+ for {set j 0} {$j < 1000} {incr j} {
+ set bits [expr {[randomInt 64]+1}]
+ set sign [randomInt 2]
+ set range [expr {2**$bits}]
+ if {$bits == 64} {set sign 1} ; # u64 is not supported by BITFIELD.
+ if {$sign} {
+ set min [expr {-($range/2)}]
+ set type "i$bits"
+ } else {
+ set min 0
+ set type "u$bits"
+ }
+ set max [expr {$min+$range-1}]
+
+ # Compare Tcl vs Redis
+ set range2 [expr {$range*2}]
+ set value [expr {($min*2)+[randomInt $range2]}]
+ set increment [expr {($min*2)+[randomInt $range2]}]
+ if {$value > 9223372036854775807} {
+ set value 9223372036854775807
+ }
+ if {$value < -9223372036854775808} {
+ set value -9223372036854775808
+ }
+ if {$increment > 9223372036854775807} {
+ set increment 9223372036854775807
+ }
+ if {$increment < -9223372036854775808} {
+ set increment -9223372036854775808
+ }
+
+ set overflow 0
+ if {$value > $max || $value < $min} {set overflow 1}
+ if {($value + $increment) > $max} {set overflow 1}
+ if {($value + $increment) < $min} {set overflow 1}
+
+ r del bits
+ set res1 [r bitfield bits overflow fail set $type 0 $value]
+ set res2 [r bitfield bits overflow fail incrby $type 0 $increment]
+
+ if {$overflow && [lindex $res1 0] ne {} &&
+ [lindex $res2 0] ne {}} {
+ fail "OW not detected where needed: $type $value+$increment"
+ }
+ if {!$overflow && ([lindex $res1 0] eq {} ||
+ [lindex $res2 0] eq {})} {
+ fail "OW detected where NOT needed: $type $value+$increment"
+ }
+ }
+ }
+
+ test {BITFIELD overflow wrap fuzzing} {
+ for {set j 0} {$j < 1000} {incr j} {
+ set bits [expr {[randomInt 64]+1}]
+ set sign [randomInt 2]
+ set range [expr {2**$bits}]
+ if {$bits == 64} {set sign 1} ; # u64 is not supported by BITFIELD.
+ if {$sign} {
+ set min [expr {-($range/2)}]
+ set type "i$bits"
+ } else {
+ set min 0
+ set type "u$bits"
+ }
+ set max [expr {$min+$range-1}]
+
+ # Compare Tcl vs Redis
+ set range2 [expr {$range*2}]
+ set value [expr {($min*2)+[randomInt $range2]}]
+ set increment [expr {($min*2)+[randomInt $range2]}]
+ if {$value > 9223372036854775807} {
+ set value 9223372036854775807
+ }
+ if {$value < -9223372036854775808} {
+ set value -9223372036854775808
+ }
+ if {$increment > 9223372036854775807} {
+ set increment 9223372036854775807
+ }
+ if {$increment < -9223372036854775808} {
+ set increment -9223372036854775808
+ }
+
+ r del bits
+ r bitfield bits overflow wrap set $type 0 $value
+ r bitfield bits overflow wrap incrby $type 0 $increment
+ set res [lindex [r bitfield bits get $type 0] 0]
+
+ set expected 0
+ if {$sign} {incr expected [expr {$max+1}]}
+ incr expected $value
+ incr expected $increment
+ set expected [expr {$expected % $range}]
+ if {$sign} {incr expected $min}
+
+ if {$res != $expected} {
+ fail "WRAP error: $type $value+$increment = $res, should be $expected"
+ }
+ }
+ }
+
+ test {BITFIELD regression for #3221} {
+ r set bits 1
+ r bitfield bits get u1 0
+ } {0}
+
+ test {BITFIELD regression for #3564} {
+ for {set j 0} {$j < 10} {incr j} {
+ r del mystring
+ set res [r BITFIELD mystring SET i8 0 10 SET i8 64 10 INCRBY i8 10 99900]
+ assert {$res eq {0 0 60}}
+ }
+ r del mystring
+ }
+}
diff --git a/tests/unit/bitops.tcl b/tests/unit/bitops.tcl
new file mode 100644
index 0000000..926f382
--- /dev/null
+++ b/tests/unit/bitops.tcl
@@ -0,0 +1,351 @@
+# Compare Redis commands against Tcl implementations of the same commands.
+proc count_bits s {
+ binary scan $s b* bits
+ string length [regsub -all {0} $bits {}]
+}
+
+proc simulate_bit_op {op args} {
+ set maxlen 0
+ set j 0
+ set count [llength $args]
+ foreach a $args {
+ binary scan $a b* bits
+ set b($j) $bits
+ if {[string length $bits] > $maxlen} {
+ set maxlen [string length $bits]
+ }
+ incr j
+ }
+ for {set j 0} {$j < $count} {incr j} {
+ if {[string length $b($j)] < $maxlen} {
+ append b($j) [string repeat 0 [expr $maxlen-[string length $b($j)]]]
+ }
+ }
+ set out {}
+ for {set x 0} {$x < $maxlen} {incr x} {
+ set bit [string range $b(0) $x $x]
+ if {$op eq {not}} {set bit [expr {!$bit}]}
+ for {set j 1} {$j < $count} {incr j} {
+ set bit2 [string range $b($j) $x $x]
+ switch $op {
+ and {set bit [expr {$bit & $bit2}]}
+ or {set bit [expr {$bit | $bit2}]}
+ xor {set bit [expr {$bit ^ $bit2}]}
+ }
+ }
+ append out $bit
+ }
+ binary format b* $out
+}
+
+start_server {tags {"bitops"}} {
+ test {BITCOUNT returns 0 against non existing key} {
+ r bitcount no-key
+ } 0
+
+ test {BITCOUNT returns 0 with out of range indexes} {
+ r set str "xxxx"
+ r bitcount str 4 10
+ } 0
+
+ test {BITCOUNT returns 0 with negative indexes where start > end} {
+ r set str "xxxx"
+ r bitcount str -6 -7
+ } 0
+
+ catch {unset num}
+ foreach vec [list "" "\xaa" "\x00\x00\xff" "foobar" "123"] {
+ incr num
+ test "BITCOUNT against test vector #$num" {
+ r set str $vec
+ assert {[r bitcount str] == [count_bits $vec]}
+ }
+ }
+
+ test {BITCOUNT fuzzing without start/end} {
+ for {set j 0} {$j < 100} {incr j} {
+ set str [randstring 0 3000]
+ r set str $str
+ assert {[r bitcount str] == [count_bits $str]}
+ }
+ }
+
+ test {BITCOUNT fuzzing with start/end} {
+ for {set j 0} {$j < 100} {incr j} {
+ set str [randstring 0 3000]
+ r set str $str
+ set l [string length $str]
+ set start [randomInt $l]
+ set end [randomInt $l]
+ if {$start > $end} {
+ lassign [list $end $start] start end
+ }
+ assert {[r bitcount str $start $end] == [count_bits [string range $str $start $end]]}
+ }
+ }
+
+ test {BITCOUNT with start, end} {
+ r set s "foobar"
+ assert_equal [r bitcount s 0 -1] [count_bits "foobar"]
+ assert_equal [r bitcount s 1 -2] [count_bits "ooba"]
+ assert_equal [r bitcount s -2 1] [count_bits ""]
+ assert_equal [r bitcount s 0 1000] [count_bits "foobar"]
+ }
+
+ test {BITCOUNT syntax error #1} {
+ catch {r bitcount s 0} e
+ set e
+ } {ERR*syntax*}
+
+ test {BITCOUNT regression test for github issue #582} {
+ r del foo
+ r setbit foo 0 1
+ if {[catch {r bitcount foo 0 4294967296} e]} {
+ assert_match {*ERR*out of range*} $e
+ set _ 1
+ } else {
+ set e
+ }
+ } {1}
+
+ test {BITCOUNT misaligned prefix} {
+ r del str
+ r set str ab
+ r bitcount str 1 -1
+ } {3}
+
+ test {BITCOUNT misaligned prefix + full words + remainder} {
+ r del str
+ r set str __PPxxxxxxxxxxxxxxxxRR__
+ r bitcount str 2 -3
+ } {74}
+
+ test {BITOP NOT (empty string)} {
+ r set s ""
+ r bitop not dest s
+ r get dest
+ } {}
+
+ test {BITOP NOT (known string)} {
+ r set s "\xaa\x00\xff\x55"
+ r bitop not dest s
+ r get dest
+ } "\x55\xff\x00\xaa"
+
+ test {BITOP where dest and target are the same key} {
+ r set s "\xaa\x00\xff\x55"
+ r bitop not s s
+ r get s
+ } "\x55\xff\x00\xaa"
+
+ test {BITOP AND|OR|XOR don't change the string with single input key} {
+ r set a "\x01\x02\xff"
+ r bitop and res1 a
+ r bitop or res2 a
+ r bitop xor res3 a
+ list [r get res1] [r get res2] [r get res3]
+ } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"]
+
+ test {BITOP missing key is considered a stream of zero} {
+ r set a "\x01\x02\xff"
+ r bitop and res1 no-suck-key a
+ r bitop or res2 no-suck-key a no-such-key
+ r bitop xor res3 no-such-key a
+ list [r get res1] [r get res2] [r get res3]
+ } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"]
+
+ test {BITOP shorter keys are zero-padded to the key with max length} {
+ r set a "\x01\x02\xff\xff"
+ r set b "\x01\x02\xff"
+ r bitop and res1 a b
+ r bitop or res2 a b
+ r bitop xor res3 a b
+ list [r get res1] [r get res2] [r get res3]
+ } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"]
+
+ foreach op {and or xor} {
+ test "BITOP $op fuzzing" {
+ for {set i 0} {$i < 10} {incr i} {
+ r flushall
+ set vec {}
+ set veckeys {}
+ set numvec [expr {[randomInt 10]+1}]
+ for {set j 0} {$j < $numvec} {incr j} {
+ set str [randstring 0 1000]
+ lappend vec $str
+ lappend veckeys vector_$j
+ r set vector_$j $str
+ }
+ r bitop $op target {*}$veckeys
+ assert_equal [r get target] [simulate_bit_op $op {*}$vec]
+ }
+ }
+ }
+
+ test {BITOP NOT fuzzing} {
+ for {set i 0} {$i < 10} {incr i} {
+ r flushall
+ set str [randstring 0 1000]
+ r set str $str
+ r bitop not target str
+ assert_equal [r get target] [simulate_bit_op not $str]
+ }
+ }
+
+ test {BITOP with integer encoded source objects} {
+ r set a 1
+ r set b 2
+ r bitop xor dest a b a
+ r get dest
+ } {2}
+
+ test {BITOP with non string source key} {
+ r del c
+ r set a 1
+ r set b 2
+ r lpush c foo
+ catch {r bitop xor dest a b c d} e
+ set e
+ } {WRONGTYPE*}
+
+ test {BITOP with empty string after non empty string (issue #529)} {
+ r flushdb
+ r set a "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
+ r bitop or x a b
+ } {32}
+
+ test {BITPOS bit=0 with empty key returns 0} {
+ r del str
+ r bitpos str 0
+ } {0}
+
+ test {BITPOS bit=1 with empty key returns -1} {
+ r del str
+ r bitpos str 1
+ } {-1}
+
+ test {BITPOS bit=0 with string less than 1 word works} {
+ r set str "\xff\xf0\x00"
+ r bitpos str 0
+ } {12}
+
+ test {BITPOS bit=1 with string less than 1 word works} {
+ r set str "\x00\x0f\x00"
+ r bitpos str 1
+ } {12}
+
+ test {BITPOS bit=0 starting at unaligned address} {
+ r set str "\xff\xf0\x00"
+ r bitpos str 0 1
+ } {12}
+
+ test {BITPOS bit=1 starting at unaligned address} {
+ r set str "\x00\x0f\xff"
+ r bitpos str 1 1
+ } {12}
+
+ test {BITPOS bit=0 unaligned+full word+reminder} {
+ r del str
+ r set str "\xff\xff\xff" ; # Prefix
+ # Followed by two (or four in 32 bit systems) full words
+ r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
+ r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
+ r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
+ # First zero bit.
+ r append str "\x0f"
+ assert {[r bitpos str 0] == 216}
+ assert {[r bitpos str 0 1] == 216}
+ assert {[r bitpos str 0 2] == 216}
+ assert {[r bitpos str 0 3] == 216}
+ assert {[r bitpos str 0 4] == 216}
+ assert {[r bitpos str 0 5] == 216}
+ assert {[r bitpos str 0 6] == 216}
+ assert {[r bitpos str 0 7] == 216}
+ assert {[r bitpos str 0 8] == 216}
+ }
+
+ test {BITPOS bit=1 unaligned+full word+reminder} {
+ r del str
+ r set str "\x00\x00\x00" ; # Prefix
+ # Followed by two (or four in 32 bit systems) full words
+ r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
+ r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
+ r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
+ # First zero bit.
+ r append str "\xf0"
+ assert {[r bitpos str 1] == 216}
+ assert {[r bitpos str 1 1] == 216}
+ assert {[r bitpos str 1 2] == 216}
+ assert {[r bitpos str 1 3] == 216}
+ assert {[r bitpos str 1 4] == 216}
+ assert {[r bitpos str 1 5] == 216}
+ assert {[r bitpos str 1 6] == 216}
+ assert {[r bitpos str 1 7] == 216}
+ assert {[r bitpos str 1 8] == 216}
+ }
+
+ test {BITPOS bit=1 returns -1 if string is all 0 bits} {
+ r set str ""
+ for {set j 0} {$j < 20} {incr j} {
+ assert {[r bitpos str 1] == -1}
+ r append str "\x00"
+ }
+ }
+
+ test {BITPOS bit=0 works with intervals} {
+ r set str "\x00\xff\x00"
+ assert {[r bitpos str 0 0 -1] == 0}
+ assert {[r bitpos str 0 1 -1] == 16}
+ assert {[r bitpos str 0 2 -1] == 16}
+ assert {[r bitpos str 0 2 200] == 16}
+ assert {[r bitpos str 0 1 1] == -1}
+ }
+
+ test {BITPOS bit=1 works with intervals} {
+ r set str "\x00\xff\x00"
+ assert {[r bitpos str 1 0 -1] == 8}
+ assert {[r bitpos str 1 1 -1] == 8}
+ assert {[r bitpos str 1 2 -1] == -1}
+ assert {[r bitpos str 1 2 200] == -1}
+ assert {[r bitpos str 1 1 1] == 8}
+ }
+
+ test {BITPOS bit=0 changes behavior if end is given} {
+ r set str "\xff\xff\xff"
+ assert {[r bitpos str 0] == 24}
+ assert {[r bitpos str 0 0] == 24}
+ assert {[r bitpos str 0 0 -1] == -1}
+ }
+
+ test {BITPOS bit=1 fuzzy testing using SETBIT} {
+ r del str
+ set max 524288; # 64k
+ set first_one_pos -1
+ for {set j 0} {$j < 1000} {incr j} {
+ assert {[r bitpos str 1] == $first_one_pos}
+ set pos [randomInt $max]
+ r setbit str $pos 1
+ if {$first_one_pos == -1 || $first_one_pos > $pos} {
+ # Update the position of the first 1 bit in the array
+ # if the bit we set is on the left of the previous one.
+ set first_one_pos $pos
+ }
+ }
+ }
+
+ test {BITPOS bit=0 fuzzy testing using SETBIT} {
+ set max 524288; # 64k
+ set first_zero_pos $max
+ r set str [string repeat "\xff" [expr $max/8]]
+ for {set j 0} {$j < 1000} {incr j} {
+ assert {[r bitpos str 0] == $first_zero_pos}
+ set pos [randomInt $max]
+ r setbit str $pos 0
+ if {$first_zero_pos > $pos} {
+ # Update the position of the first 0 bit in the array
+ # if the bit we clear is on the left of the previous one.
+ set first_zero_pos $pos
+ }
+ }
+ }
+}
diff --git a/tests/unit/dump.tcl b/tests/unit/dump.tcl
new file mode 100644
index 0000000..f5a29a0
--- /dev/null
+++ b/tests/unit/dump.tcl
@@ -0,0 +1,311 @@
+start_server {tags {"dump"}} {
+ test {DUMP / RESTORE are able to serialize / unserialize a simple key} {
+ r set foo bar
+ set encoded [r dump foo]
+ r del foo
+ list [r exists foo] [r restore foo 0 $encoded] [r ttl foo] [r get foo]
+ } {0 OK -1 bar}
+
+ test {RESTORE can set an arbitrary expire to the materialized key} {
+ r set foo bar
+ set encoded [r dump foo]
+ r del foo
+ r restore foo 5000 $encoded
+ set ttl [r pttl foo]
+ assert {$ttl >= 3000 && $ttl <= 5000}
+ r get foo
+ } {bar}
+
+ test {RESTORE can set an expire that overflows a 32 bit integer} {
+ r set foo bar
+ set encoded [r dump foo]
+ r del foo
+ r restore foo 2569591501 $encoded
+ set ttl [r pttl foo]
+ assert {$ttl >= (2569591501-3000) && $ttl <= 2569591501}
+ r get foo
+ } {bar}
+
+ test {RESTORE returns an error of the key already exists} {
+ r set foo bar
+ set e {}
+ catch {r restore foo 0 "..."} e
+ set e
+ } {*BUSYKEY*}
+
+ test {RESTORE can overwrite an existing key with REPLACE} {
+ r set foo bar1
+ set encoded1 [r dump foo]
+ r set foo bar2
+ set encoded2 [r dump foo]
+ r del foo
+ r restore foo 0 $encoded1
+ r restore foo 0 $encoded2 replace
+ r get foo
+ } {bar2}
+
+ test {RESTORE can detect a syntax error for unrecongized options} {
+ catch {r restore foo 0 "..." invalid-option} e
+ set e
+ } {*syntax*}
+
+ test {DUMP of non existing key returns nil} {
+ r dump nonexisting_key
+ } {}
+
+ test {MIGRATE is caching connections} {
+ # Note, we run this as first test so that the connection cache
+ # is empty.
+ set first [srv 0 client]
+ r set key "Some Value"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert_match {*migrate_cached_sockets:0*} [r -1 info]
+ r -1 migrate $second_host $second_port key 9 1000
+ assert_match {*migrate_cached_sockets:1*} [r -1 info]
+ }
+ }
+
+ test {MIGRATE cached connections are released after some time} {
+ after 15000
+ assert_match {*migrate_cached_sockets:0*} [r info]
+ }
+
+ test {MIGRATE is able to migrate a key between two instances} {
+ set first [srv 0 client]
+ r set key "Some Value"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key] == 1}
+ assert {[$second exists key] == 0}
+ set ret [r -1 migrate $second_host $second_port key 9 5000]
+ assert {$ret eq {OK}}
+ assert {[$first exists key] == 0}
+ assert {[$second exists key] == 1}
+ assert {[$second get key] eq {Some Value}}
+ assert {[$second ttl key] == -1}
+ }
+ }
+
+ test {MIGRATE is able to copy a key between two instances} {
+ set first [srv 0 client]
+ r del list
+ r lpush list a b c d
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists list] == 1}
+ assert {[$second exists list] == 0}
+ set ret [r -1 migrate $second_host $second_port list 9 5000 copy]
+ assert {$ret eq {OK}}
+ assert {[$first exists list] == 1}
+ assert {[$second exists list] == 1}
+ assert {[$first lrange list 0 -1] eq [$second lrange list 0 -1]}
+ }
+ }
+
+ test {MIGRATE will not overwrite existing keys, unless REPLACE is used} {
+ set first [srv 0 client]
+ r del list
+ r lpush list a b c d
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists list] == 1}
+ assert {[$second exists list] == 0}
+ $second set list somevalue
+ catch {r -1 migrate $second_host $second_port list 9 5000 copy} e
+ assert_match {ERR*} $e
+ set res [r -1 migrate $second_host $second_port list 9 5000 copy replace]
+ assert {$ret eq {OK}}
+ assert {[$first exists list] == 1}
+ assert {[$second exists list] == 1}
+ assert {[$first lrange list 0 -1] eq [$second lrange list 0 -1]}
+ }
+ }
+
+ test {MIGRATE propagates TTL correctly} {
+ set first [srv 0 client]
+ r set key "Some Value"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key] == 1}
+ assert {[$second exists key] == 0}
+ $first expire key 10
+ set ret [r -1 migrate $second_host $second_port key 9 5000]
+ assert {$ret eq {OK}}
+ assert {[$first exists key] == 0}
+ assert {[$second exists key] == 1}
+ assert {[$second get key] eq {Some Value}}
+ assert {[$second ttl key] >= 7 && [$second ttl key] <= 10}
+ }
+ }
+
+ test {MIGRATE can correctly transfer large values} {
+ set first [srv 0 client]
+ r del key
+ for {set j 0} {$j < 40000} {incr j} {
+ r rpush key 1 2 3 4 5 6 7 8 9 10
+ r rpush key "item 1" "item 2" "item 3" "item 4" "item 5" \
+ "item 6" "item 7" "item 8" "item 9" "item 10"
+ }
+ assert {[string length [r dump key]] > (1024*64)}
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key] == 1}
+ assert {[$second exists key] == 0}
+ set ret [r -1 migrate $second_host $second_port key 9 10000]
+ assert {$ret eq {OK}}
+ assert {[$first exists key] == 0}
+ assert {[$second exists key] == 1}
+ assert {[$second ttl key] == -1}
+ assert {[$second llen key] == 40000*20}
+ }
+ }
+
+ test {MIGRATE can correctly transfer hashes} {
+ set first [srv 0 client]
+ r del key
+ r hmset key field1 "item 1" field2 "item 2" field3 "item 3" \
+ field4 "item 4" field5 "item 5" field6 "item 6"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key] == 1}
+ assert {[$second exists key] == 0}
+ set ret [r -1 migrate $second_host $second_port key 9 10000]
+ assert {$ret eq {OK}}
+ assert {[$first exists key] == 0}
+ assert {[$second exists key] == 1}
+ assert {[$second ttl key] == -1}
+ }
+ }
+
+ test {MIGRATE timeout actually works} {
+ set first [srv 0 client]
+ r set key "Some Value"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key] == 1}
+ assert {[$second exists key] == 0}
+
+ set rd [redis_deferring_client]
+ $rd debug sleep 1.0 ; # Make second server unable to reply.
+ set e {}
+ catch {r -1 migrate $second_host $second_port key 9 500} e
+ assert_match {IOERR*} $e
+ }
+ }
+
+ test {MIGRATE can migrate multiple keys at once} {
+ set first [srv 0 client]
+ r set key1 "v1"
+ r set key2 "v2"
+ r set key3 "v3"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ assert {[$first exists key1] == 1}
+ assert {[$second exists key1] == 0}
+ set ret [r -1 migrate $second_host $second_port "" 9 5000 keys key1 key2 key3]
+ assert {$ret eq {OK}}
+ assert {[$first exists key1] == 0}
+ assert {[$first exists key2] == 0}
+ assert {[$first exists key3] == 0}
+ assert {[$second get key1] eq {v1}}
+ assert {[$second get key2] eq {v2}}
+ assert {[$second get key3] eq {v3}}
+ }
+ }
+
+ test {MIGRATE with multiple keys must have empty key arg} {
+ catch {r MIGRATE 127.0.0.1 6379 NotEmpty 9 5000 keys a b c} e
+ set e
+ } {*empty string*}
+
+ test {MIGRATE with mutliple keys migrate just existing ones} {
+ set first [srv 0 client]
+ r set key1 "v1"
+ r set key2 "v2"
+ r set key3 "v3"
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ set ret [r -1 migrate $second_host $second_port "" 9 5000 keys nokey-1 nokey-2 nokey-2]
+ assert {$ret eq {NOKEY}}
+
+ assert {[$first exists key1] == 1}
+ assert {[$second exists key1] == 0}
+ set ret [r -1 migrate $second_host $second_port "" 9 5000 keys nokey-1 key1 nokey-2 key2 nokey-3 key3]
+ assert {$ret eq {OK}}
+ assert {[$first exists key1] == 0}
+ assert {[$first exists key2] == 0}
+ assert {[$first exists key3] == 0}
+ assert {[$second get key1] eq {v1}}
+ assert {[$second get key2] eq {v2}}
+ assert {[$second get key3] eq {v3}}
+ }
+ }
+
+ test {MIGRATE with multiple keys: stress command rewriting} {
+ set first [srv 0 client]
+ r flushdb
+ r mset a 1 b 2 c 3 d 4 c 5 e 6 f 7 g 8 h 9 i 10 l 11 m 12 n 13 o 14 p 15 q 16
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ set ret [r -1 migrate $second_host $second_port "" 9 5000 keys a b c d e f g h i l m n o p q]
+
+ assert {[$first dbsize] == 0}
+ assert {[$second dbsize] == 15}
+ }
+ }
+
+ test {MIGRATE with multiple keys: delete just ack keys} {
+ set first [srv 0 client]
+ r flushdb
+ r mset a 1 b 2 c 3 d 4 c 5 e 6 f 7 g 8 h 9 i 10 l 11 m 12 n 13 o 14 p 15 q 16
+ start_server {tags {"repl"}} {
+ set second [srv 0 client]
+ set second_host [srv 0 host]
+ set second_port [srv 0 port]
+
+ $second mset c _ d _; # Two busy keys and no REPLACE used
+
+ catch {r -1 migrate $second_host $second_port "" 9 5000 keys a b c d e f g h i l m n o p q} e
+
+ assert {[$first dbsize] == 2}
+ assert {[$second dbsize] == 15}
+ assert {[$first exists c] == 1}
+ assert {[$first exists d] == 1}
+ }
+ }
+
+}
diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl
new file mode 100644
index 0000000..0a50dd3
--- /dev/null
+++ b/tests/unit/expire.tcl
@@ -0,0 +1,207 @@
+start_server {tags {"expire"}} {
+ test {EXPIRE - set timeouts multiple times} {
+ r set x foobar
+ set v1 [r expire x 5]
+ set v2 [r ttl x]
+ set v3 [r expire x 10]
+ set v4 [r ttl x]
+ r expire x 2
+ list $v1 $v2 $v3 $v4
+ } {1 [45] 1 10}
+
+ test {EXPIRE - It should be still possible to read 'x'} {
+ r get x
+ } {foobar}
+
+ tags {"slow"} {
+ test {EXPIRE - After 2.1 seconds the key should no longer be here} {
+ after 2100
+ list [r get x] [r exists x]
+ } {{} 0}
+ }
+
+ test {EXPIRE - write on expire should work} {
+ r del x
+ r lpush x foo
+ r expire x 1000
+ r lpush x bar
+ r lrange x 0 -1
+ } {bar foo}
+
+ test {EXPIREAT - Check for EXPIRE alike behavior} {
+ r del x
+ r set x foo
+ r expireat x [expr [clock seconds]+15]
+ r ttl x
+ } {1[345]}
+
+ test {SETEX - Set + Expire combo operation. Check for TTL} {
+ r setex x 12 test
+ r ttl x
+ } {1[012]}
+
+ test {SETEX - Check value} {
+ r get x
+ } {test}
+
+ test {SETEX - Overwrite old key} {
+ r setex y 1 foo
+ r get y
+ } {foo}
+
+ tags {"slow"} {
+ test {SETEX - Wait for the key to expire} {
+ after 1100
+ r get y
+ } {}
+ }
+
+ test {SETEX - Wrong time parameter} {
+ catch {r setex z -10 foo} e
+ set _ $e
+ } {*invalid expire*}
+
+ test {PERSIST can undo an EXPIRE} {
+ r set x foo
+ r expire x 50
+ list [r ttl x] [r persist x] [r ttl x] [r get x]
+ } {50 1 -1 foo}
+
+ test {PERSIST returns 0 against non existing or non volatile keys} {
+ r set x foo
+ list [r persist foo] [r persist nokeyatall]
+ } {0 0}
+
+ test {EXPIRE pricision is now the millisecond} {
+ # This test is very likely to do a false positive if the
+ # server is under pressure, so if it does not work give it a few more
+ # chances.
+ for {set j 0} {$j < 3} {incr j} {
+ r del x
+ r setex x 1 somevalue
+ after 900
+ set a [r get x]
+ after 1100
+ set b [r get x]
+ if {$a eq {somevalue} && $b eq {}} break
+ }
+ list $a $b
+ } {somevalue {}}
+
+ test {PEXPIRE/PSETEX/PEXPIREAT can set sub-second expires} {
+ # This test is very likely to do a false positive if the
+ # server is under pressure, so if it does not work give it a few more
+ # chances.
+ for {set j 0} {$j < 3} {incr j} {
+ r del x y z
+ r psetex x 100 somevalue
+ after 80
+ set a [r get x]
+ after 120
+ set b [r get x]
+
+ r set x somevalue
+ r pexpire x 100
+ after 80
+ set c [r get x]
+ after 120
+ set d [r get x]
+
+ r set x somevalue
+ r pexpireat x [expr ([clock seconds]*1000)+100]
+ after 80
+ set e [r get x]
+ after 120
+ set f [r get x]
+
+ if {$a eq {somevalue} && $b eq {} &&
+ $c eq {somevalue} && $d eq {} &&
+ $e eq {somevalue} && $f eq {}} break
+ }
+ list $a $b
+ } {somevalue {}}
+
+ test {TTL returns tiem to live in seconds} {
+ r del x
+ r setex x 10 somevalue
+ set ttl [r ttl x]
+ assert {$ttl > 8 && $ttl <= 10}
+ }
+
+ test {PTTL returns time to live in milliseconds} {
+ r del x
+ r setex x 1 somevalue
+ set ttl [r pttl x]
+ assert {$ttl > 900 && $ttl <= 1000}
+ }
+
+ test {TTL / PTTL return -1 if key has no expire} {
+ r del x
+ r set x hello
+ list [r ttl x] [r pttl x]
+ } {-1 -1}
+
+ test {TTL / PTTL return -2 if key does not exit} {
+ r del x
+ list [r ttl x] [r pttl x]
+ } {-2 -2}
+
+ test {Redis should actively expire keys incrementally} {
+ r flushdb
+ r psetex key1 500 a
+ r psetex key2 500 a
+ r psetex key3 500 a
+ set size1 [r dbsize]
+ # Redis expires random keys ten times every second so we are
+ # fairly sure that all the three keys should be evicted after
+ # one second.
+ after 1000
+ set size2 [r dbsize]
+ list $size1 $size2
+ } {3 0}
+
+ test {Redis should lazy expire keys} {
+ r flushdb
+ r debug set-active-expire 0
+ r psetex key1 500 a
+ r psetex key2 500 a
+ r psetex key3 500 a
+ set size1 [r dbsize]
+ # Redis expires random keys ten times every second so we are
+ # fairly sure that all the three keys should be evicted after
+ # one second.
+ after 1000
+ set size2 [r dbsize]
+ r mget key1 key2 key3
+ set size3 [r dbsize]
+ r debug set-active-expire 1
+ list $size1 $size2 $size3
+ } {3 3 0}
+
+ test {EXPIRE should not resurrect keys (issue #1026)} {
+ r debug set-active-expire 0
+ r set foo bar
+ r pexpire foo 500
+ after 1000
+ r expire foo 10
+ r debug set-active-expire 1
+ r exists foo
+ } {0}
+
+ test {5 keys in, 5 keys out} {
+ r flushdb
+ r set a c
+ r expire a 5
+ r set t c
+ r set e c
+ r set s c
+ r set foo b
+ lsort [r keys *]
+ } {a e foo s t}
+
+ test {EXPIRE with empty string as TTL should report an error} {
+ r set foo bar
+ catch {r expire foo ""} e
+ set e
+ } {*not an integer*}
+}
diff --git a/tests/unit/geo.tcl b/tests/unit/geo.tcl
new file mode 100644
index 0000000..fdbfbf1
--- /dev/null
+++ b/tests/unit/geo.tcl
@@ -0,0 +1,308 @@
+# Helper functions to simulate search-in-radius in the Tcl side in order to
+# verify the Redis implementation with a fuzzy test.
+proc geo_degrad deg {expr {$deg*atan(1)*8/360}}
+
+proc geo_distance {lon1d lat1d lon2d lat2d} {
+ set lon1r [geo_degrad $lon1d]
+ set lat1r [geo_degrad $lat1d]
+ set lon2r [geo_degrad $lon2d]
+ set lat2r [geo_degrad $lat2d]
+ set v [expr {sin(($lon2r - $lon1r) / 2)}]
+ set u [expr {sin(($lat2r - $lat1r) / 2)}]
+ expr {2.0 * 6372797.560856 * \
+ asin(sqrt($u * $u + cos($lat1r) * cos($lat2r) * $v * $v))}
+}
+
+proc geo_random_point {lonvar latvar} {
+ upvar 1 $lonvar lon
+ upvar 1 $latvar lat
+ # Note that the actual latitude limit should be -85 to +85, we restrict
+ # the test to -70 to +70 since in this range the algorithm is more precise
+ # while outside this range occasionally some element may be missing.
+ set lon [expr {-180 + rand()*360}]
+ set lat [expr {-70 + rand()*140}]
+}
+
+# Return elements non common to both the lists.
+# This code is from http://wiki.tcl.tk/15489
+proc compare_lists {List1 List2} {
+ set DiffList {}
+ foreach Item $List1 {
+ if {[lsearch -exact $List2 $Item] == -1} {
+ lappend DiffList $Item
+ }
+ }
+ foreach Item $List2 {
+ if {[lsearch -exact $List1 $Item] == -1} {
+ if {[lsearch -exact $DiffList $Item] == -1} {
+ lappend DiffList $Item
+ }
+ }
+ }
+ return $DiffList
+}
+
+# The following list represents sets of random seed, search position
+# and radius that caused bugs in the past. It is used by the randomized
+# test later as a starting point. When the regression vectors are scanned
+# the code reverts to using random data.
+#
+# The format is: seed km lon lat
+set regression_vectors {
+ {1412 156 149.29737817929004 15.95807862745508}
+ {441574 143 59.235461856813856 66.269555127373678}
+ {160645 187 -101.88575239939883 49.061997951502917}
+ {750269 154 -90.187939661642517 66.615930412251487}
+ {342880 145 163.03472387745728 64.012747720821181}
+ {729955 143 137.86663517256579 63.986745399416776}
+ {939895 151 59.149620271823181 65.204186651485145}
+ {1412 156 149.29737817929004 15.95807862745508}
+ {564862 149 84.062063109158544 -65.685403922426232}
+}
+set rv_idx 0
+
+start_server {tags {"geo"}} {
+ test {GEOADD create} {
+ r geoadd nyc -73.9454966 40.747533 "lic market"
+ } {1}
+
+ test {GEOADD update} {
+ r geoadd nyc -73.9454966 40.747533 "lic market"
+ } {0}
+
+ test {GEOADD invalid coordinates} {
+ catch {
+ r geoadd nyc -73.9454966 40.747533 "lic market" \
+ foo bar "luck market"
+ } err
+ set err
+ } {*valid*}
+
+ test {GEOADD multi add} {
+ r geoadd nyc -73.9733487 40.7648057 "central park n/q/r" -73.9903085 40.7362513 "union square" -74.0131604 40.7126674 "wtc one" -73.7858139 40.6428986 "jfk" -73.9375699 40.7498929 "q4" -73.9564142 40.7480973 4545
+ } {6}
+
+ test {Check geoset values} {
+ r zrange nyc 0 -1 withscores
+ } {{wtc one} 1791873972053020 {union square} 1791875485187452 {central park n/q/r} 1791875761332224 4545 1791875796750882 {lic market} 1791875804419201 q4 1791875830079666 jfk 1791895905559723}
+
+ test {GEORADIUS simple (sorted)} {
+ r georadius nyc -73.9798091 40.7598464 3 km asc
+ } {{central park n/q/r} 4545 {union square}}
+
+ test {GEORADIUS withdist (sorted)} {
+ r georadius nyc -73.9798091 40.7598464 3 km withdist asc
+ } {{{central park n/q/r} 0.7750} {4545 2.3651} {{union square} 2.7697}}
+
+ test {GEORADIUS with COUNT} {
+ r georadius nyc -73.9798091 40.7598464 10 km COUNT 3
+ } {{central park n/q/r} 4545 {union square}}
+
+ test {GEORADIUS with COUNT but missing integer argument} {
+ catch {r georadius nyc -73.9798091 40.7598464 10 km COUNT} e
+ set e
+ } {ERR*syntax*}
+
+ test {GEORADIUS with COUNT DESC} {
+ r georadius nyc -73.9798091 40.7598464 10 km COUNT 2 DESC
+ } {{wtc one} q4}
+
+ test {GEORADIUS HUGE, issue #2767} {
+ r geoadd users -47.271613776683807 -54.534504198047678 user_000000
+ llength [r GEORADIUS users 0 0 50000 km WITHCOORD]
+ } {1}
+
+ test {GEORADIUSBYMEMBER simple (sorted)} {
+ r georadiusbymember nyc "wtc one" 7 km
+ } {{wtc one} {union square} {central park n/q/r} 4545 {lic market}}
+
+ test {GEORADIUSBYMEMBER withdist (sorted)} {
+ r georadiusbymember nyc "wtc one" 7 km withdist
+ } {{{wtc one} 0.0000} {{union square} 3.2544} {{central park n/q/r} 6.7000} {4545 6.1975} {{lic market} 6.8969}}
+
+ test {GEOHASH is able to return geohash strings} {
+ # Example from Wikipedia.
+ r del points
+ r geoadd points -5.6 42.6 test
+ lindex [r geohash points test] 0
+ } {ezs42e44yx0}
+
+ test {GEOPOS simple} {
+ r del points
+ r geoadd points 10 20 a 30 40 b
+ lassign [lindex [r geopos points a b] 0] x1 y1
+ lassign [lindex [r geopos points a b] 1] x2 y2
+ assert {abs($x1 - 10) < 0.001}
+ assert {abs($y1 - 20) < 0.001}
+ assert {abs($x2 - 30) < 0.001}
+ assert {abs($y2 - 40) < 0.001}
+ }
+
+ test {GEOPOS missing element} {
+ r del points
+ r geoadd points 10 20 a 30 40 b
+ lindex [r geopos points a x b] 1
+ } {}
+
+ test {GEODIST simple & unit} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ set m [r geodist points Palermo Catania]
+ assert {$m > 166274 && $m < 166275}
+ set km [r geodist points Palermo Catania km]
+ assert {$km > 166.2 && $km < 166.3}
+ }
+
+ test {GEODIST missing elements} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ set m [r geodist points Palermo Agrigento]
+ assert {$m eq {}}
+ set m [r geodist points Ragusa Agrigento]
+ assert {$m eq {}}
+ set m [r geodist empty_key Palermo Catania]
+ assert {$m eq {}}
+ }
+
+ test {GEORADIUS STORE option: syntax error} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ catch {r georadius points 13.361389 38.115556 50 km store} e
+ set e
+ } {*ERR*syntax*}
+
+ test {GEORANGE STORE option: incompatible options} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ catch {r georadius points 13.361389 38.115556 50 km store points2 withdist} e
+ assert_match {*ERR*} $e
+ catch {r georadius points 13.361389 38.115556 50 km store points2 withhash} e
+ assert_match {*ERR*} $e
+ catch {r georadius points 13.361389 38.115556 50 km store points2 withcoords} e
+ assert_match {*ERR*} $e
+ }
+
+ test {GEORANGE STORE option: plain usage} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ r georadius points 13.361389 38.115556 500 km store points2
+ assert_equal [r zrange points 0 -1] [r zrange points2 0 -1]
+ }
+
+ test {GEORANGE STOREDIST option: plain usage} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ r georadius points 13.361389 38.115556 500 km storedist points2
+ set res [r zrange points2 0 -1 withscores]
+ assert {[lindex $res 1] < 1}
+ assert {[lindex $res 3] > 166}
+ assert {[lindex $res 3] < 167}
+ }
+
+ test {GEORANGE STOREDIST option: COUNT ASC and DESC} {
+ r del points
+ r geoadd points 13.361389 38.115556 "Palermo" \
+ 15.087269 37.502669 "Catania"
+ r georadius points 13.361389 38.115556 500 km storedist points2 asc count 1
+ assert {[r zcard points2] == 1}
+ set res [r zrange points2 0 -1 withscores]
+ assert {[lindex $res 0] eq "Palermo"}
+
+ r georadius points 13.361389 38.115556 500 km storedist points2 desc count 1
+ assert {[r zcard points2] == 1}
+ set res [r zrange points2 0 -1 withscores]
+ assert {[lindex $res 0] eq "Catania"}
+ }
+
+ test {GEOADD + GEORANGE randomized test} {
+ set attempt 30
+ while {[incr attempt -1]} {
+ set rv [lindex $regression_vectors $rv_idx]
+ incr rv_idx
+
+ unset -nocomplain debuginfo
+ set srand_seed [clock milliseconds]
+ if {$rv ne {}} {set srand_seed [lindex $rv 0]}
+ lappend debuginfo "srand_seed is $srand_seed"
+ expr {srand($srand_seed)} ; # If you need a reproducible run
+ r del mypoints
+
+ if {[randomInt 10] == 0} {
+ # From time to time use very big radiuses
+ set radius_km [expr {[randomInt 50000]+10}]
+ } else {
+ # Normally use a few - ~200km radiuses to stress
+ # test the code the most in edge cases.
+ set radius_km [expr {[randomInt 200]+10}]
+ }
+ if {$rv ne {}} {set radius_km [lindex $rv 1]}
+ set radius_m [expr {$radius_km*1000}]
+ geo_random_point search_lon search_lat
+ if {$rv ne {}} {
+ set search_lon [lindex $rv 2]
+ set search_lat [lindex $rv 3]
+ }
+ lappend debuginfo "Search area: $search_lon,$search_lat $radius_km km"
+ set tcl_result {}
+ set argv {}
+ for {set j 0} {$j < 20000} {incr j} {
+ geo_random_point lon lat
+ lappend argv $lon $lat "place:$j"
+ set distance [geo_distance $lon $lat $search_lon $search_lat]
+ if {$distance < $radius_m} {
+ lappend tcl_result "place:$j"
+ }
+ lappend debuginfo "place:$j $lon $lat [expr {$distance/1000}] km"
+ }
+ r geoadd mypoints {*}$argv
+ set res [lsort [r georadius mypoints $search_lon $search_lat $radius_km km]]
+ set res2 [lsort $tcl_result]
+ set test_result OK
+
+ if {$res != $res2} {
+ set rounding_errors 0
+ set diff [compare_lists $res $res2]
+ foreach place $diff {
+ set mydist [geo_distance $lon $lat $search_lon $search_lat]
+ set mydist [expr $mydist/1000]
+ if {($mydist / $radius_km) > 0.999} {incr rounding_errors}
+ }
+ # Make sure this is a real error and not a rounidng issue.
+ if {[llength $diff] == $rounding_errors} {
+ set res $res2; # Error silenced
+ }
+ }
+
+ if {$res != $res2} {
+ set diff [compare_lists $res $res2]
+ puts "*** Possible problem in GEO radius query ***"
+ puts "Redis: $res"
+ puts "Tcl : $res2"
+ puts "Diff : $diff"
+ puts [join $debuginfo "\n"]
+ foreach place $diff {
+ if {[lsearch -exact $res2 $place] != -1} {
+ set where "(only in Tcl)"
+ } else {
+ set where "(only in Redis)"
+ }
+ lassign [lindex [r geopos mypoints $place] 0] lon lat
+ set mydist [geo_distance $lon $lat $search_lon $search_lat]
+ set mydist [expr $mydist/1000]
+ puts "$place -> [r geopos mypoints $place] $mydist $where"
+ if {($mydist / $radius_km) > 0.999} {incr rounding_errors}
+ }
+ set test_result FAIL
+ }
+ unset -nocomplain debuginfo
+ if {$test_result ne {OK}} break
+ }
+ set test_result
+ } {OK}
+}
diff --git a/tests/unit/hyperloglog.tcl b/tests/unit/hyperloglog.tcl
new file mode 100644
index 0000000..7d36b7a
--- /dev/null
+++ b/tests/unit/hyperloglog.tcl
@@ -0,0 +1,185 @@
+start_server {tags {"hll"}} {
+ test {HyperLogLog self test passes} {
+ catch {r pfselftest} e
+ set e
+ } {OK}
+
+ test {PFADD without arguments creates an HLL value} {
+ r pfadd hll
+ r exists hll
+ } {1}
+
+ test {Approximated cardinality after creation is zero} {
+ r pfcount hll
+ } {0}
+
+ test {PFADD returns 1 when at least 1 reg was modified} {
+ r pfadd hll a b c
+ } {1}
+
+ test {PFADD returns 0 when no reg was modified} {
+ r pfadd hll a b c
+ } {0}
+
+ test {PFADD works with empty string (regression)} {
+ r pfadd hll ""
+ }
+
+ # Note that the self test stresses much better the
+ # cardinality estimation error. We are testing just the
+ # command implementation itself here.
+ test {PFCOUNT returns approximated cardinality of set} {
+ r del hll
+ set res {}
+ r pfadd hll 1 2 3 4 5
+ lappend res [r pfcount hll]
+ # Call it again to test cached value invalidation.
+ r pfadd hll 6 7 8 8 9 10
+ lappend res [r pfcount hll]
+ set res
+ } {5 10}
+
+ test {HyperLogLogs are promote from sparse to dense} {
+ r del hll
+ r config set hll-sparse-max-bytes 3000
+ set n 0
+ while {$n < 100000} {
+ set elements {}
+ for {set j 0} {$j < 100} {incr j} {lappend elements [expr rand()]}
+ incr n 100
+ r pfadd hll {*}$elements
+ set card [r pfcount hll]
+ set err [expr {abs($card-$n)}]
+ assert {$err < (double($card)/100)*5}
+ if {$n < 1000} {
+ assert {[r pfdebug encoding hll] eq {sparse}}
+ } elseif {$n > 10000} {
+ assert {[r pfdebug encoding hll] eq {dense}}
+ }
+ }
+ }
+
+ test {HyperLogLog sparse encoding stress test} {
+ for {set x 0} {$x < 1000} {incr x} {
+ r del hll1 hll2
+ set numele [randomInt 100]
+ set elements {}
+ for {set j 0} {$j < $numele} {incr j} {
+ lappend elements [expr rand()]
+ }
+ # Force dense representation of hll2
+ r pfadd hll2
+ r pfdebug todense hll2
+ r pfadd hll1 {*}$elements
+ r pfadd hll2 {*}$elements
+ assert {[r pfdebug encoding hll1] eq {sparse}}
+ assert {[r pfdebug encoding hll2] eq {dense}}
+ # Cardinality estimated should match exactly.
+ assert {[r pfcount hll1] eq [r pfcount hll2]}
+ }
+ }
+
+ test {Corrupted sparse HyperLogLogs are detected: Additionl at tail} {
+ r del hll
+ r pfadd hll a b c
+ r append hll "hello"
+ set e {}
+ catch {r pfcount hll} e
+ set e
+ } {*INVALIDOBJ*}
+
+ test {Corrupted sparse HyperLogLogs are detected: Broken magic} {
+ r del hll
+ r pfadd hll a b c
+ r setrange hll 0 "0123"
+ set e {}
+ catch {r pfcount hll} e
+ set e
+ } {*WRONGTYPE*}
+
+ test {Corrupted sparse HyperLogLogs are detected: Invalid encoding} {
+ r del hll
+ r pfadd hll a b c
+ r setrange hll 4 "x"
+ set e {}
+ catch {r pfcount hll} e
+ set e
+ } {*WRONGTYPE*}
+
+ test {Corrupted dense HyperLogLogs are detected: Wrong length} {
+ r del hll
+ r pfadd hll a b c
+ r setrange hll 4 "\x00"
+ set e {}
+ catch {r pfcount hll} e
+ set e
+ } {*WRONGTYPE*}
+
+ test {PFADD, PFCOUNT, PFMERGE type checking works} {
+ r set foo bar
+ catch {r pfadd foo 1} e
+ assert_match {*WRONGTYPE*} $e
+ catch {r pfcount foo} e
+ assert_match {*WRONGTYPE*} $e
+ catch {r pfmerge bar foo} e
+ assert_match {*WRONGTYPE*} $e
+ catch {r pfmerge foo bar} e
+ assert_match {*WRONGTYPE*} $e
+ }
+
+ test {PFMERGE results on the cardinality of union of sets} {
+ r del hll hll1 hll2 hll3
+ r pfadd hll1 a b c
+ r pfadd hll2 b c d
+ r pfadd hll3 c d e
+ r pfmerge hll hll1 hll2 hll3
+ r pfcount hll
+ } {5}
+
+ test {PFCOUNT multiple-keys merge returns cardinality of union #1} {
+ r del hll1 hll2 hll3
+ for {set x 1} {$x < 10000} {incr x} {
+ r pfadd hll1 "foo-$x"
+ r pfadd hll2 "bar-$x"
+ r pfadd hll3 "zap-$x"
+
+ set card [r pfcount hll1 hll2 hll3]
+ set realcard [expr {$x*3}]
+ set err [expr {abs($card-$realcard)}]
+ assert {$err < (double($card)/100)*5}
+ }
+ }
+
+ test {PFCOUNT multiple-keys merge returns cardinality of union #2} {
+ r del hll1 hll2 hll3
+ set elements {}
+ for {set x 1} {$x < 10000} {incr x} {
+ for {set j 1} {$j <= 3} {incr j} {
+ set rint [randomInt 20000]
+ r pfadd hll$j $rint
+ lappend elements $rint
+ }
+ }
+ set realcard [llength [lsort -unique $elements]]
+ set card [r pfcount hll1 hll2 hll3]
+ set err [expr {abs($card-$realcard)}]
+ assert {$err < (double($card)/100)*5}
+ }
+
+ test {PFDEBUG GETREG returns the HyperLogLog raw registers} {
+ r del hll
+ r pfadd hll 1 2 3
+ llength [r pfdebug getreg hll]
+ } {16384}
+
+ test {PFADD / PFCOUNT cache invalidation works} {
+ r del hll
+ r pfadd hll a b c
+ r pfcount hll
+ assert {[r getrange hll 15 15] eq "\x00"}
+ r pfadd hll a b c
+ assert {[r getrange hll 15 15] eq "\x00"}
+ r pfadd hll 1 2 3
+ assert {[r getrange hll 15 15] eq "\x80"}
+ }
+}
diff --git a/tests/unit/introspection-2.tcl b/tests/unit/introspection-2.tcl
new file mode 100644
index 0000000..350a8a0
--- /dev/null
+++ b/tests/unit/introspection-2.tcl
@@ -0,0 +1,23 @@
+start_server {tags {"introspection"}} {
+ test {TTL and TYPYE do not alter the last access time of a key} {
+ r set foo bar
+ after 3000
+ r ttl foo
+ r type foo
+ assert {[r object idletime foo] >= 2}
+ }
+
+ test {TOUCH alters the last access time of a key} {
+ r set foo bar
+ after 3000
+ r touch foo
+ assert {[r object idletime foo] < 2}
+ }
+
+ test {TOUCH returns the number of existing keys specified} {
+ r flushdb
+ r set key1 1
+ r set key2 2
+ r touch key0 key1 key2 key3
+ } 2
+}
diff --git a/tests/unit/introspection.tcl b/tests/unit/introspection.tcl
new file mode 100644
index 0000000..f6477d9
--- /dev/null
+++ b/tests/unit/introspection.tcl
@@ -0,0 +1,60 @@
+start_server {tags {"introspection"}} {
+ test {CLIENT LIST} {
+ r client list
+ } {*addr=*:* fd=* age=* idle=* flags=N db=9 sub=0 psub=0 multi=-1 qbuf=0 qbuf-free=* obl=0 oll=0 omem=0 events=r cmd=client*}
+
+ test {MONITOR can log executed commands} {
+ set rd [redis_deferring_client]
+ $rd monitor
+ assert_match {*OK*} [$rd read]
+ r set foo bar
+ r get foo
+ list [$rd read] [$rd read]
+ } {*"set" "foo"*"get" "foo"*}
+
+ test {MONITOR can log commands issued by the scripting engine} {
+ set rd [redis_deferring_client]
+ $rd monitor
+ $rd read ;# Discard the OK
+ r eval {redis.call('set',KEYS[1],ARGV[1])} 1 foo bar
+ assert_match {*eval*} [$rd read]
+ assert_match {*lua*"set"*"foo"*"bar"*} [$rd read]
+ }
+
+ test {CLIENT GETNAME should return NIL if name is not assigned} {
+ r client getname
+ } {}
+
+ test {CLIENT LIST shows empty fields for unassigned names} {
+ r client list
+ } {*name= *}
+
+ test {CLIENT SETNAME does not accept spaces} {
+ catch {r client setname "foo bar"} e
+ set e
+ } {ERR*}
+
+ test {CLIENT SETNAME can assign a name to this connection} {
+ assert_equal [r client setname myname] {OK}
+ r client list
+ } {*name=myname*}
+
+ test {CLIENT SETNAME can change the name of an existing connection} {
+ assert_equal [r client setname someothername] {OK}
+ r client list
+ } {*name=someothername*}
+
+ test {After CLIENT SETNAME, connection can still be closed} {
+ set rd [redis_deferring_client]
+ $rd client setname foobar
+ assert_equal [$rd read] "OK"
+ assert_match {*foobar*} [r client list]
+ $rd close
+ # Now the client should no longer be listed
+ wait_for_condition 50 100 {
+ [string match {*foobar*} [r client list]] == 0
+ } else {
+ fail "Client still listed in CLIENT LIST after SETNAME."
+ }
+ }
+}
diff --git a/tests/unit/keyspace.tcl b/tests/unit/keyspace.tcl
new file mode 100644
index 0000000..d4e7bf5
--- /dev/null
+++ b/tests/unit/keyspace.tcl
@@ -0,0 +1,275 @@
+start_server {tags {"keyspace"}} {
+ test {DEL against a single item} {
+ r set x foo
+ assert {[r get x] eq "foo"}
+ r del x
+ r get x
+ } {}
+
+ test {Vararg DEL} {
+ r set foo1 a
+ r set foo2 b
+ r set foo3 c
+ list [r del foo1 foo2 foo3 foo4] [r mget foo1 foo2 foo3]
+ } {3 {{} {} {}}}
+
+ test {KEYS with pattern} {
+ foreach key {key_x key_y key_z foo_a foo_b foo_c} {
+ r set $key hello
+ }
+ lsort [r keys foo*]
+ } {foo_a foo_b foo_c}
+
+ test {KEYS to get all keys} {
+ lsort [r keys *]
+ } {foo_a foo_b foo_c key_x key_y key_z}
+
+ test {DBSIZE} {
+ r dbsize
+ } {6}
+
+ test {DEL all keys} {
+ foreach key [r keys *] {r del $key}
+ r dbsize
+ } {0}
+
+ test "DEL against expired key" {
+ r debug set-active-expire 0
+ r setex keyExpire 1 valExpire
+ after 1100
+ assert_equal 0 [r del keyExpire]
+ r debug set-active-expire 1
+ }
+
+ test {EXISTS} {
+ set res {}
+ r set newkey test
+ append res [r exists newkey]
+ r del newkey
+ append res [r exists newkey]
+ } {10}
+
+ test {Zero length value in key. SET/GET/EXISTS} {
+ r set emptykey {}
+ set res [r get emptykey]
+ append res [r exists emptykey]
+ r del emptykey
+ append res [r exists emptykey]
+ } {10}
+
+ test {Commands pipelining} {
+ set fd [r channel]
+ puts -nonewline $fd "SET k1 xyzk\r\nGET k1\r\nPING\r\n"
+ flush $fd
+ set res {}
+ append res [string match OK* [r read]]
+ append res [r read]
+ append res [string match PONG* [r read]]
+ format $res
+ } {1xyzk1}
+
+ test {Non existing command} {
+ catch {r foobaredcommand} err
+ string match ERR* $err
+ } {1}
+
+ test {RENAME basic usage} {
+ r set mykey hello
+ r rename mykey mykey1
+ r rename mykey1 mykey2
+ r get mykey2
+ } {hello}
+
+ test {RENAME source key should no longer exist} {
+ r exists mykey
+ } {0}
+
+ test {RENAME against already existing key} {
+ r set mykey a
+ r set mykey2 b
+ r rename mykey2 mykey
+ set res [r get mykey]
+ append res [r exists mykey2]
+ } {b0}
+
+ test {RENAMENX basic usage} {
+ r del mykey
+ r del mykey2
+ r set mykey foobar
+ r renamenx mykey mykey2
+ set res [r get mykey2]
+ append res [r exists mykey]
+ } {foobar0}
+
+ test {RENAMENX against already existing key} {
+ r set mykey foo
+ r set mykey2 bar
+ r renamenx mykey mykey2
+ } {0}
+
+ test {RENAMENX against already existing key (2)} {
+ set res [r get mykey]
+ append res [r get mykey2]
+ } {foobar}
+
+ test {RENAME against non existing source key} {
+ catch {r rename nokey foobar} err
+ format $err
+ } {ERR*}
+
+ test {RENAME where source and dest key are the same (existing)} {
+ r set mykey foo
+ r rename mykey mykey
+ } {OK}
+
+ test {RENAMENX where source and dest key are the same (existing)} {
+ r set mykey foo
+ r renamenx mykey mykey
+ } {0}
+
+ test {RENAME where source and dest key are the same (non existing)} {
+ r del mykey
+ catch {r rename mykey mykey} err
+ format $err
+ } {ERR*}
+
+ test {RENAME with volatile key, should move the TTL as well} {
+ r del mykey mykey2
+ r set mykey foo
+ r expire mykey 100
+ assert {[r ttl mykey] > 95 && [r ttl mykey] <= 100}
+ r rename mykey mykey2
+ assert {[r ttl mykey2] > 95 && [r ttl mykey2] <= 100}
+ }
+
+ test {RENAME with volatile key, should not inherit TTL of target key} {
+ r del mykey mykey2
+ r set mykey foo
+ r set mykey2 bar
+ r expire mykey2 100
+ assert {[r ttl mykey] == -1 && [r ttl mykey2] > 0}
+ r rename mykey mykey2
+ r ttl mykey2
+ } {-1}
+
+ test {DEL all keys again (DB 0)} {
+ foreach key [r keys *] {
+ r del $key
+ }
+ r dbsize
+ } {0}
+
+ test {DEL all keys again (DB 1)} {
+ r select 10
+ foreach key [r keys *] {
+ r del $key
+ }
+ set res [r dbsize]
+ r select 9
+ format $res
+ } {0}
+
+ test {MOVE basic usage} {
+ r set mykey foobar
+ r move mykey 10
+ set res {}
+ lappend res [r exists mykey]
+ lappend res [r dbsize]
+ r select 10
+ lappend res [r get mykey]
+ lappend res [r dbsize]
+ r select 9
+ format $res
+ } [list 0 0 foobar 1]
+
+ test {MOVE against key existing in the target DB} {
+ r set mykey hello
+ r move mykey 10
+ } {0}
+
+ test {MOVE against non-integer DB (#1428)} {
+ r set mykey hello
+ catch {r move mykey notanumber} e
+ set e
+ } {*ERR*index out of range}
+
+ test {MOVE can move key expire metadata as well} {
+ r select 10
+ r flushdb
+ r select 9
+ r set mykey foo ex 100
+ r move mykey 10
+ assert {[r ttl mykey] == -2}
+ r select 10
+ assert {[r ttl mykey] > 0 && [r ttl mykey] <= 100}
+ assert {[r get mykey] eq "foo"}
+ r select 9
+ }
+
+ test {MOVE does not create an expire if it does not exist} {
+ r select 10
+ r flushdb
+ r select 9
+ r set mykey foo
+ r move mykey 10
+ assert {[r ttl mykey] == -2}
+ r select 10
+ assert {[r ttl mykey] == -1}
+ assert {[r get mykey] eq "foo"}
+ r select 9
+ }
+
+ test {SET/GET keys in different DBs} {
+ r set a hello
+ r set b world
+ r select 10
+ r set a foo
+ r set b bared
+ r select 9
+ set res {}
+ lappend res [r get a]
+ lappend res [r get b]
+ r select 10
+ lappend res [r get a]
+ lappend res [r get b]
+ r select 9
+ format $res
+ } {hello world foo bared}
+
+ test {RANDOMKEY} {
+ r flushdb
+ r set foo x
+ r set bar y
+ set foo_seen 0
+ set bar_seen 0
+ for {set i 0} {$i < 100} {incr i} {
+ set rkey [r randomkey]
+ if {$rkey eq {foo}} {
+ set foo_seen 1
+ }
+ if {$rkey eq {bar}} {
+ set bar_seen 1
+ }
+ }
+ list $foo_seen $bar_seen
+ } {1 1}
+
+ test {RANDOMKEY against empty DB} {
+ r flushdb
+ r randomkey
+ } {}
+
+ test {RANDOMKEY regression 1} {
+ r flushdb
+ r set x 10
+ r del x
+ r randomkey
+ } {}
+
+ test {KEYS * two times with long key, Github issue #1208} {
+ r flushdb
+ r set dlskeriewrioeuwqoirueioqwrueoqwrueqw test
+ r keys *
+ r keys *
+ } {dlskeriewrioeuwqoirueioqwrueoqwrueqw}
+}
diff --git a/tests/unit/latency-monitor.tcl b/tests/unit/latency-monitor.tcl
new file mode 100644
index 0000000..b736cad
--- /dev/null
+++ b/tests/unit/latency-monitor.tcl
@@ -0,0 +1,50 @@
+start_server {tags {"latency-monitor"}} {
+ # Set a threshold high enough to avoid spurious latency events.
+ r config set latency-monitor-threshold 200
+ r latency reset
+
+ test {Test latency events logging} {
+ r debug sleep 0.3
+ after 1100
+ r debug sleep 0.4
+ after 1100
+ r debug sleep 0.5
+ assert {[r latency history command] >= 3}
+ }
+
+ test {LATENCY HISTORY output is ok} {
+ set min 250
+ set max 450
+ foreach event [r latency history command] {
+ lassign $event time latency
+ assert {$latency >= $min && $latency <= $max}
+ incr min 100
+ incr max 100
+ set last_time $time ; # Used in the next test
+ }
+ }
+
+ test {LATENCY LATEST output is ok} {
+ foreach event [r latency latest] {
+ lassign $event eventname time latency max
+ assert {$eventname eq "command"}
+ assert {$max >= 450 & $max <= 650}
+ assert {$time == $last_time}
+ break
+ }
+ }
+
+ test {LATENCY HISTORY / RESET with wrong event name is fine} {
+ assert {[llength [r latency history blabla]] == 0}
+ assert {[r latency reset blabla] == 0}
+ }
+
+ test {LATENCY DOCTOR produces some output} {
+ assert {[string length [r latency doctor]] > 0}
+ }
+
+ test {LATENCY RESET is able to reset events} {
+ assert {[r latency reset] > 0}
+ assert {[r latency latest] eq {}}
+ }
+}
diff --git a/tests/unit/lazyfree.tcl b/tests/unit/lazyfree.tcl
new file mode 100644
index 0000000..4e99449
--- /dev/null
+++ b/tests/unit/lazyfree.tcl
@@ -0,0 +1,39 @@
+start_server {tags {"lazyfree"}} {
+ test "UNLINK can reclaim memory in background" {
+ set orig_mem [s used_memory]
+ set args {}
+ for {set i 0} {$i < 100000} {incr i} {
+ lappend args $i
+ }
+ r sadd myset {*}$args
+ assert {[r scard myset] == 100000}
+ set peak_mem [s used_memory]
+ assert {[r unlink myset] == 1}
+ assert {$peak_mem > $orig_mem+1000000}
+ wait_for_condition 50 100 {
+ [s used_memory] < $peak_mem &&
+ [s used_memory] < $orig_mem*2
+ } else {
+ fail "Memory is not reclaimed by UNLINK"
+ }
+ }
+
+ test "FLUSHDB ASYNC can reclaim memory in background" {
+ set orig_mem [s used_memory]
+ set args {}
+ for {set i 0} {$i < 100000} {incr i} {
+ lappend args $i
+ }
+ r sadd myset {*}$args
+ assert {[r scard myset] == 100000}
+ set peak_mem [s used_memory]
+ r flushdb async
+ assert {$peak_mem > $orig_mem+1000000}
+ wait_for_condition 50 100 {
+ [s used_memory] < $peak_mem &&
+ [s used_memory] < $orig_mem*2
+ } else {
+ fail "Memory is not reclaimed by FLUSHDB ASYNC"
+ }
+ }
+}
diff --git a/tests/unit/limits.tcl b/tests/unit/limits.tcl
new file mode 100644
index 0000000..b37ea9b
--- /dev/null
+++ b/tests/unit/limits.tcl
@@ -0,0 +1,16 @@
+start_server {tags {"limits"} overrides {maxclients 10}} {
+ test {Check if maxclients works refusing connections} {
+ set c 0
+ catch {
+ while {$c < 50} {
+ incr c
+ set rd [redis_deferring_client]
+ $rd ping
+ $rd read
+ after 100
+ }
+ } e
+ assert {$c > 8 && $c <= 10}
+ set e
+ } {*ERR max*reached*}
+}
diff --git a/tests/unit/maxmemory.tcl b/tests/unit/maxmemory.tcl
new file mode 100644
index 0000000..0c3f6b3
--- /dev/null
+++ b/tests/unit/maxmemory.tcl
@@ -0,0 +1,144 @@
+start_server {tags {"maxmemory"}} {
+ test "Without maxmemory small integers are shared" {
+ r config set maxmemory 0
+ r set a 1
+ assert {[r object refcount a] > 1}
+ }
+
+ test "With maxmemory and non-LRU policy integers are still shared" {
+ r config set maxmemory 1073741824
+ r config set maxmemory-policy allkeys-random
+ r set a 1
+ assert {[r object refcount a] > 1}
+ }
+
+ test "With maxmemory and LRU policy integers are not shared" {
+ r config set maxmemory 1073741824
+ r config set maxmemory-policy allkeys-lru
+ r set a 1
+ r config set maxmemory-policy volatile-lru
+ r set b 1
+ assert {[r object refcount a] == 1}
+ assert {[r object refcount b] == 1}
+ r config set maxmemory 0
+ }
+
+ foreach policy {
+ allkeys-random allkeys-lru allkeys-lfu volatile-lru volatile-lfu volatile-random volatile-ttl
+ } {
+ test "maxmemory - is the memory limit honoured? (policy $policy)" {
+ # make sure to start with a blank instance
+ r flushall
+ # Get the current memory limit and calculate a new limit.
+ # We just add 100k to the current memory size so that it is
+ # fast for us to reach that limit.
+ set used [s used_memory]
+ set limit [expr {$used+100*1024}]
+ r config set maxmemory $limit
+ r config set maxmemory-policy $policy
+ # Now add keys until the limit is almost reached.
+ set numkeys 0
+ while 1 {
+ r setex [randomKey] 10000 x
+ incr numkeys
+ if {[s used_memory]+4096 > $limit} {
+ assert {$numkeys > 10}
+ break
+ }
+ }
+ # If we add the same number of keys already added again, we
+ # should still be under the limit.
+ for {set j 0} {$j < $numkeys} {incr j} {
+ r setex [randomKey] 10000 x
+ }
+ assert {[s used_memory] < ($limit+4096)}
+ }
+ }
+
+ foreach policy {
+ allkeys-random allkeys-lru volatile-lru volatile-random volatile-ttl
+ } {
+ test "maxmemory - only allkeys-* should remove non-volatile keys ($policy)" {
+ # make sure to start with a blank instance
+ r flushall
+ # Get the current memory limit and calculate a new limit.
+ # We just add 100k to the current memory size so that it is
+ # fast for us to reach that limit.
+ set used [s used_memory]
+ set limit [expr {$used+100*1024}]
+ r config set maxmemory $limit
+ r config set maxmemory-policy $policy
+ # Now add keys until the limit is almost reached.
+ set numkeys 0
+ while 1 {
+ r set [randomKey] x
+ incr numkeys
+ if {[s used_memory]+4096 > $limit} {
+ assert {$numkeys > 10}
+ break
+ }
+ }
+ # If we add the same number of keys already added again and
+ # the policy is allkeys-* we should still be under the limit.
+ # Otherwise we should see an error reported by Redis.
+ set err 0
+ for {set j 0} {$j < $numkeys} {incr j} {
+ if {[catch {r set [randomKey] x} e]} {
+ if {[string match {*used memory*} $e]} {
+ set err 1
+ }
+ }
+ }
+ if {[string match allkeys-* $policy]} {
+ assert {[s used_memory] < ($limit+4096)}
+ } else {
+ assert {$err == 1}
+ }
+ }
+ }
+
+ foreach policy {
+ volatile-lru volatile-lfu volatile-random volatile-ttl
+ } {
+ test "maxmemory - policy $policy should only remove volatile keys." {
+ # make sure to start with a blank instance
+ r flushall
+ # Get the current memory limit and calculate a new limit.
+ # We just add 100k to the current memory size so that it is
+ # fast for us to reach that limit.
+ set used [s used_memory]
+ set limit [expr {$used+100*1024}]
+ r config set maxmemory $limit
+ r config set maxmemory-policy $policy
+ # Now add keys until the limit is almost reached.
+ set numkeys 0
+ while 1 {
+ # Odd keys are volatile
+ # Even keys are non volatile
+ if {$numkeys % 2} {
+ r setex "key:$numkeys" 10000 x
+ } else {
+ r set "key:$numkeys" x
+ }
+ if {[s used_memory]+4096 > $limit} {
+ assert {$numkeys > 10}
+ break
+ }
+ incr numkeys
+ }
+ # Now we add the same number of volatile keys already added.
+ # We expect Redis to evict only volatile keys in order to make
+ # space.
+ set err 0
+ for {set j 0} {$j < $numkeys} {incr j} {
+ catch {r setex "foo:$j" 10000 x}
+ }
+ # We should still be under the limit.
+ assert {[s used_memory] < ($limit+4096)}
+ # However all our non volatile keys should be here.
+ for {set j 0} {$j < $numkeys} {incr j 2} {
+ assert {[r exists "key:$j"]}
+ }
+ }
+ }
+}
diff --git a/tests/unit/memefficiency.tcl b/tests/unit/memefficiency.tcl
new file mode 100644
index 0000000..7ca9a70
--- /dev/null
+++ b/tests/unit/memefficiency.tcl
@@ -0,0 +1,37 @@
+proc test_memory_efficiency {range} {
+ r flushall
+ set rd [redis_deferring_client]
+ set base_mem [s used_memory]
+ set written 0
+ for {set j 0} {$j < 10000} {incr j} {
+ set key key:$j
+ set val [string repeat A [expr {int(rand()*$range)}]]
+ $rd set $key $val
+ incr written [string length $key]
+ incr written [string length $val]
+ incr written 2 ;# A separator is the minimum to store key-value data.
+ }
+ for {set j 0} {$j < 10000} {incr j} {
+ $rd read ; # Discard replies
+ }
+
+ set current_mem [s used_memory]
+ set used [expr {$current_mem-$base_mem}]
+ set efficiency [expr {double($written)/$used}]
+ return $efficiency
+}
+
+start_server {tags {"memefficiency"}} {
+ foreach {size_range expected_min_efficiency} {
+ 32 0.15
+ 64 0.25
+ 128 0.35
+ 1024 0.75
+ 16384 0.82
+ } {
+ test "Memory efficiency with values in range $size_range" {
+ set efficiency [test_memory_efficiency $size_range]
+ assert {$efficiency >= $expected_min_efficiency}
+ }
+ }
+}
diff --git a/tests/unit/multi.tcl b/tests/unit/multi.tcl
new file mode 100644
index 0000000..6655bf6
--- /dev/null
+++ b/tests/unit/multi.tcl
@@ -0,0 +1,309 @@
+start_server {tags {"multi"}} {
+ test {MUTLI / EXEC basics} {
+ r del mylist
+ r rpush mylist a
+ r rpush mylist b
+ r rpush mylist c
+ r multi
+ set v1 [r lrange mylist 0 -1]
+ set v2 [r ping]
+ set v3 [r exec]
+ list $v1 $v2 $v3
+ } {QUEUED QUEUED {{a b c} PONG}}
+
+ test {DISCARD} {
+ r del mylist
+ r rpush mylist a
+ r rpush mylist b
+ r rpush mylist c
+ r multi
+ set v1 [r del mylist]
+ set v2 [r discard]
+ set v3 [r lrange mylist 0 -1]
+ list $v1 $v2 $v3
+ } {QUEUED OK {a b c}}
+
+ test {Nested MULTI are not allowed} {
+ set err {}
+ r multi
+ catch {[r multi]} err
+ r exec
+ set _ $err
+ } {*ERR MULTI*}
+
+ test {MULTI where commands alter argc/argv} {
+ r sadd myset a
+ r multi
+ r spop myset
+ list [r exec] [r exists myset]
+ } {a 0}
+
+ test {WATCH inside MULTI is not allowed} {
+ set err {}
+ r multi
+ catch {[r watch x]} err
+ r exec
+ set _ $err
+ } {*ERR WATCH*}
+
+ test {EXEC fails if there are errors while queueing commands #1} {
+ r del foo1 foo2
+ r multi
+ r set foo1 bar1
+ catch {r non-existing-command}
+ r set foo2 bar2
+ catch {r exec} e
+ assert_match {EXECABORT*} $e
+ list [r exists foo1] [r exists foo2]
+ } {0 0}
+
+ test {EXEC fails if there are errors while queueing commands #2} {
+ set rd [redis_deferring_client]
+ r del foo1 foo2
+ r multi
+ r set foo1 bar1
+ $rd config set maxmemory 1
+ assert {[$rd read] eq {OK}}
+ catch {r lpush mylist myvalue}
+ $rd config set maxmemory 0
+ assert {[$rd read] eq {OK}}
+ r set foo2 bar2
+ catch {r exec} e
+ assert_match {EXECABORT*} $e
+ $rd close
+ list [r exists foo1] [r exists foo2]
+ } {0 0}
+
+ test {If EXEC aborts, the client MULTI state is cleared} {
+ r del foo1 foo2
+ r multi
+ r set foo1 bar1
+ catch {r non-existing-command}
+ r set foo2 bar2
+ catch {r exec} e
+ assert_match {EXECABORT*} $e
+ r ping
+ } {PONG}
+
+ test {EXEC works on WATCHed key not modified} {
+ r watch x y z
+ r watch k
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {EXEC fail on WATCHed key modified (1 key of 1 watched)} {
+ r set x 30
+ r watch x
+ r set x 40
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {EXEC fail on WATCHed key modified (1 key of 5 watched)} {
+ r set x 30
+ r watch a b x k z
+ r set x 40
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {EXEC fail on WATCHed key modified by SORT with STORE even if the result is empty} {
+ r flushdb
+ r lpush foo bar
+ r watch foo
+ r sort emptylist store foo
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {After successful EXEC key is no longer watched} {
+ r set x 30
+ r watch x
+ r multi
+ r ping
+ r exec
+ r set x 40
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {After failed EXEC key is no longer watched} {
+ r set x 30
+ r watch x
+ r set x 40
+ r multi
+ r ping
+ r exec
+ r set x 40
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {It is possible to UNWATCH} {
+ r set x 30
+ r watch x
+ r set x 40
+ r unwatch
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {UNWATCH when there is nothing watched works as expected} {
+ r unwatch
+ } {OK}
+
+ test {FLUSHALL is able to touch the watched keys} {
+ r set x 30
+ r watch x
+ r flushall
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {FLUSHALL does not touch non affected keys} {
+ r del x
+ r watch x
+ r flushall
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {FLUSHDB is able to touch the watched keys} {
+ r set x 30
+ r watch x
+ r flushdb
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {FLUSHDB does not touch non affected keys} {
+ r del x
+ r watch x
+ r flushdb
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {WATCH is able to remember the DB a key belongs to} {
+ r select 5
+ r set x 30
+ r watch x
+ r select 1
+ r set x 10
+ r select 5
+ r multi
+ r ping
+ set res [r exec]
+ # Restore original DB
+ r select 9
+ set res
+ } {PONG}
+
+ test {WATCH will consider touched keys target of EXPIRE} {
+ r del x
+ r set x foo
+ r watch x
+ r expire x 10
+ r multi
+ r ping
+ r exec
+ } {}
+
+ test {WATCH will not consider touched expired keys} {
+ r del x
+ r set x foo
+ r expire x 1
+ r watch x
+ after 1100
+ r multi
+ r ping
+ r exec
+ } {PONG}
+
+ test {DISCARD should clear the WATCH dirty flag on the client} {
+ r watch x
+ r set x 10
+ r multi
+ r discard
+ r multi
+ r incr x
+ r exec
+ } {11}
+
+ test {DISCARD should UNWATCH all the keys} {
+ r watch x
+ r set x 10
+ r multi
+ r discard
+ r set x 10
+ r multi
+ r incr x
+ r exec
+ } {11}
+
+ test {MULTI / EXEC is propagated correctly (single write command)} {
+ set repl [attach_to_replication_stream]
+ r multi
+ r set foo bar
+ r exec
+ assert_replication_stream $repl {
+ {select *}
+ {multi}
+ {set foo bar}
+ {exec}
+ }
+ close_replication_stream $repl
+ }
+
+ test {MULTI / EXEC is propagated correctly (empty transaction)} {
+ set repl [attach_to_replication_stream]
+ r multi
+ r exec
+ r set foo bar
+ assert_replication_stream $repl {
+ {select *}
+ {set foo bar}
+ }
+ close_replication_stream $repl
+ }
+
+ test {MULTI / EXEC is propagated correctly (read-only commands)} {
+ r set foo value1
+ set repl [attach_to_replication_stream]
+ r multi
+ r get foo
+ r exec
+ r set foo value2
+ assert_replication_stream $repl {
+ {select *}
+ {set foo value2}
+ }
+ close_replication_stream $repl
+ }
+
+ test {MULTI / EXEC is propagated correctly (write command, no effect)} {
+ r del bar foo bar
+ set repl [attach_to_replication_stream]
+ r multi
+ r del foo
+ r exec
+ assert_replication_stream $repl {
+ {select *}
+ {multi}
+ {exec}
+ }
+ close_replication_stream $repl
+ }
+}
diff --git a/tests/unit/obuf-limits.tcl b/tests/unit/obuf-limits.tcl
new file mode 100644
index 0000000..5d625cf
--- /dev/null
+++ b/tests/unit/obuf-limits.tcl
@@ -0,0 +1,73 @@
+start_server {tags {"obuf-limits"}} {
+ test {Client output buffer hard limit is enforced} {
+ r config set client-output-buffer-limit {pubsub 100000 0 0}
+ set rd1 [redis_deferring_client]
+
+ $rd1 subscribe foo
+ set reply [$rd1 read]
+ assert {$reply eq "subscribe foo 1"}
+
+ set omem 0
+ while 1 {
+ r publish foo bar
+ set clients [split [r client list] "\r\n"]
+ set c [split [lindex $clients 1] " "]
+ if {![regexp {omem=([0-9]+)} $c - omem]} break
+ if {$omem > 200000} break
+ }
+ assert {$omem >= 90000 && $omem < 200000}
+ $rd1 close
+ }
+
+ test {Client output buffer soft limit is not enforced if time is not overreached} {
+ r config set client-output-buffer-limit {pubsub 0 100000 10}
+ set rd1 [redis_deferring_client]
+
+ $rd1 subscribe foo
+ set reply [$rd1 read]
+ assert {$reply eq "subscribe foo 1"}
+
+ set omem 0
+ set start_time 0
+ set time_elapsed 0
+ while 1 {
+ r publish foo bar
+ set clients [split [r client list] "\r\n"]
+ set c [split [lindex $clients 1] " "]
+ if {![regexp {omem=([0-9]+)} $c - omem]} break
+ if {$omem > 100000} {
+ if {$start_time == 0} {set start_time [clock seconds]}
+ set time_elapsed [expr {[clock seconds]-$start_time}]
+ if {$time_elapsed >= 5} break
+ }
+ }
+ assert {$omem >= 100000 && $time_elapsed >= 5 && $time_elapsed <= 10}
+ $rd1 close
+ }
+
+ test {Client output buffer soft limit is enforced if time is overreached} {
+ r config set client-output-buffer-limit {pubsub 0 100000 3}
+ set rd1 [redis_deferring_client]
+
+ $rd1 subscribe foo
+ set reply [$rd1 read]
+ assert {$reply eq "subscribe foo 1"}
+
+ set omem 0
+ set start_time 0
+ set time_elapsed 0
+ while 1 {
+ r publish foo bar
+ set clients [split [r client list] "\r\n"]
+ set c [split [lindex $clients 1] " "]
+ if {![regexp {omem=([0-9]+)} $c - omem]} break
+ if {$omem > 100000} {
+ if {$start_time == 0} {set start_time [clock seconds]}
+ set time_elapsed [expr {[clock seconds]-$start_time}]
+ if {$time_elapsed >= 10} break
+ }
+ }
+ assert {$omem >= 100000 && $time_elapsed < 6}
+ $rd1 close
+ }
+}
diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl
new file mode 100644
index 0000000..1d21b56
--- /dev/null
+++ b/tests/unit/other.tcl
@@ -0,0 +1,246 @@
+start_server {tags {"other"}} {
+ if {$::force_failure} {
+ # This is used just for test suite development purposes.
+ test {Failing test} {
+ format err
+ } {ok}
+ }
+
+ test {SAVE - make sure there are all the types as values} {
+ # Wait for a background saving in progress to terminate
+ waitForBgsave r
+ r lpush mysavelist hello
+ r lpush mysavelist world
+ r set myemptykey {}
+ r set mynormalkey {blablablba}
+ r zadd mytestzset 10 a
+ r zadd mytestzset 20 b
+ r zadd mytestzset 30 c
+ r save
+ } {OK}
+
+ tags {slow} {
+ if {$::accurate} {set iterations 10000} else {set iterations 1000}
+ foreach fuzztype {binary alpha compr} {
+ test "FUZZ stresser with data model $fuzztype" {
+ set err 0
+ for {set i 0} {$i < $iterations} {incr i} {
+ set fuzz [randstring 0 512 $fuzztype]
+ r set foo $fuzz
+ set got [r get foo]
+ if {$got ne $fuzz} {
+ set err [list $fuzz $got]
+ break
+ }
+ }
+ set _ $err
+ } {0}
+ }
+ }
+
+ test {BGSAVE} {
+ waitForBgsave r
+ r flushdb
+ r save
+ r set x 10
+ r bgsave
+ waitForBgsave r
+ r debug reload
+ r get x
+ } {10}
+
+ test {SELECT an out of range DB} {
+ catch {r select 1000000} err
+ set _ $err
+ } {*index is out of range*}
+
+ tags {consistency} {
+ if {![catch {package require sha1}]} {
+ if {$::accurate} {set numops 10000} else {set numops 1000}
+ test {Check consistency of different data types after a reload} {
+ r flushdb
+ createComplexDataset r $numops
+ set dump [csvdump r]
+ set sha1 [r debug digest]
+ r debug reload
+ set sha1_after [r debug digest]
+ if {$sha1 eq $sha1_after} {
+ set _ 1
+ } else {
+ set newdump [csvdump r]
+ puts "Consistency test failed!"
+ puts "You can inspect the two dumps in /tmp/repldump*.txt"
+
+ set fd [open /tmp/repldump1.txt w]
+ puts $fd $dump
+ close $fd
+ set fd [open /tmp/repldump2.txt w]
+ puts $fd $newdump
+ close $fd
+
+ set _ 0
+ }
+ } {1}
+
+ test {Same dataset digest if saving/reloading as AOF?} {
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set sha1_after [r debug digest]
+ if {$sha1 eq $sha1_after} {
+ set _ 1
+ } else {
+ set newdump [csvdump r]
+ puts "Consistency test failed!"
+ puts "You can inspect the two dumps in /tmp/aofdump*.txt"
+
+ set fd [open /tmp/aofdump1.txt w]
+ puts $fd $dump
+ close $fd
+ set fd [open /tmp/aofdump2.txt w]
+ puts $fd $newdump
+ close $fd
+
+ set _ 0
+ }
+ } {1}
+ }
+ }
+
+ test {EXPIRES after a reload (snapshot + append only file rewrite)} {
+ r flushdb
+ r set x 10
+ r expire x 1000
+ r save
+ r debug reload
+ set ttl [r ttl x]
+ set e1 [expr {$ttl > 900 && $ttl <= 1000}]
+ r bgrewriteaof
+ waitForBgrewriteaof r
+ r debug loadaof
+ set ttl [r ttl x]
+ set e2 [expr {$ttl > 900 && $ttl <= 1000}]
+ list $e1 $e2
+ } {1 1}
+
+ test {EXPIRES after AOF reload (without rewrite)} {
+ r flushdb
+ r config set appendonly yes
+ r set x somevalue
+ r expire x 1000
+ r setex y 2000 somevalue
+ r set z somevalue
+ r expireat z [expr {[clock seconds]+3000}]
+
+ # Milliseconds variants
+ r set px somevalue
+ r pexpire px 1000000
+ r psetex py 2000000 somevalue
+ r set pz somevalue
+ r pexpireat pz [expr {([clock seconds]+3000)*1000}]
+
+ # Reload and check
+ waitForBgrewriteaof r
+ # We need to wait two seconds to avoid false positives here, otherwise
+ # the DEBUG LOADAOF command may read a partial file.
+ # Another solution would be to set the fsync policy to no, since this
+ # prevents write() to be delayed by the completion of fsync().
+ after 2000
+ r debug loadaof
+ set ttl [r ttl x]
+ assert {$ttl > 900 && $ttl <= 1000}
+ set ttl [r ttl y]
+ assert {$ttl > 1900 && $ttl <= 2000}
+ set ttl [r ttl z]
+ assert {$ttl > 2900 && $ttl <= 3000}
+ set ttl [r ttl px]
+ assert {$ttl > 900 && $ttl <= 1000}
+ set ttl [r ttl py]
+ assert {$ttl > 1900 && $ttl <= 2000}
+ set ttl [r ttl pz]
+ assert {$ttl > 2900 && $ttl <= 3000}
+ r config set appendonly no
+ }
+
+ tags {protocol} {
+ test {PIPELINING stresser (also a regression for the old epoll bug)} {
+ set fd2 [socket $::host $::port]
+ fconfigure $fd2 -encoding binary -translation binary
+ puts -nonewline $fd2 "SELECT 9\r\n"
+ flush $fd2
+ gets $fd2
+
+ for {set i 0} {$i < 100000} {incr i} {
+ set q {}
+ set val "0000${i}0000"
+ append q "SET key:$i $val\r\n"
+ puts -nonewline $fd2 $q
+ set q {}
+ append q "GET key:$i\r\n"
+ puts -nonewline $fd2 $q
+ }
+ flush $fd2
+
+ for {set i 0} {$i < 100000} {incr i} {
+ gets $fd2 line
+ gets $fd2 count
+ set count [string range $count 1 end]
+ set val [read $fd2 $count]
+ read $fd2 2
+ }
+ close $fd2
+ set _ 1
+ } {1}
+ }
+
+ test {APPEND basics} {
+ r del foo
+ list [r append foo bar] [r get foo] \
+ [r append foo 100] [r get foo]
+ } {3 bar 6 bar100}
+
+ test {APPEND basics, integer encoded values} {
+ set res {}
+ r del foo
+ r append foo 1
+ r append foo 2
+ lappend res [r get foo]
+ r set foo 1
+ r append foo 2
+ lappend res [r get foo]
+ } {12 12}
+
+ test {APPEND fuzzing} {
+ set err {}
+ foreach type {binary alpha compr} {
+ set buf {}
+ r del x
+ for {set i 0} {$i < 1000} {incr i} {
+ set bin [randstring 0 10 $type]
+ append buf $bin
+ r append x $bin
+ }
+ if {$buf != [r get x]} {
+ set err "Expected '$buf' found '[r get x]'"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ # Leave the user with a clean DB before to exit
+ test {FLUSHDB} {
+ set aux {}
+ r select 9
+ r flushdb
+ lappend aux [r dbsize]
+ r select 10
+ r flushdb
+ lappend aux [r dbsize]
+ } {0 0}
+
+ test {Perform a final SAVE to leave a clean DB on disk} {
+ waitForBgsave r
+ r save
+ } {OK}
+}
diff --git a/tests/unit/printver.tcl b/tests/unit/printver.tcl
new file mode 100644
index 0000000..c80f451
--- /dev/null
+++ b/tests/unit/printver.tcl
@@ -0,0 +1,6 @@
+start_server {} {
+ set i [r info]
+ regexp {redis_version:(.*?)\r\n} $i - version
+ regexp {redis_git_sha1:(.*?)\r\n} $i - sha1
+ puts "Testing Redis version $version ($sha1)"
+}
diff --git a/tests/unit/protocol.tcl b/tests/unit/protocol.tcl
new file mode 100644
index 0000000..ac99c3a
--- /dev/null
+++ b/tests/unit/protocol.tcl
@@ -0,0 +1,117 @@
+start_server {tags {"protocol"}} {
+ test "Handle an empty query" {
+ reconnect
+ r write "\r\n"
+ r flush
+ assert_equal "PONG" [r ping]
+ }
+
+ test "Negative multibulk length" {
+ reconnect
+ r write "*-10\r\n"
+ r flush
+ assert_equal PONG [r ping]
+ }
+
+ test "Out of range multibulk length" {
+ reconnect
+ r write "*20000000\r\n"
+ r flush
+ assert_error "*invalid multibulk length*" {r read}
+ }
+
+ test "Wrong multibulk payload header" {
+ reconnect
+ r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\nfooz\r\n"
+ r flush
+ assert_error "*expected '$', got 'f'*" {r read}
+ }
+
+ test "Negative multibulk payload length" {
+ reconnect
+ r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$-10\r\n"
+ r flush
+ assert_error "*invalid bulk length*" {r read}
+ }
+
+ test "Out of range multibulk payload length" {
+ reconnect
+ r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$2000000000\r\n"
+ r flush
+ assert_error "*invalid bulk length*" {r read}
+ }
+
+ test "Non-number multibulk payload length" {
+ reconnect
+ r write "*3\r\n\$3\r\nSET\r\n\$1\r\nx\r\n\$blabla\r\n"
+ r flush
+ assert_error "*invalid bulk length*" {r read}
+ }
+
+ test "Multi bulk request not followed by bulk arguments" {
+ reconnect
+ r write "*1\r\nfoo\r\n"
+ r flush
+ assert_error "*expected '$', got 'f'*" {r read}
+ }
+
+ test "Generic wrong number of args" {
+ reconnect
+ assert_error "*wrong*arguments*ping*" {r ping x y z}
+ }
+
+ test "Unbalanced number of quotes" {
+ reconnect
+ r write "set \"\"\"test-key\"\"\" test-value\r\n"
+ r write "ping\r\n"
+ r flush
+ assert_error "*unbalanced*" {r read}
+ }
+
+ set c 0
+ foreach seq [list "\x00" "*\x00" "$\x00"] {
+ incr c
+ test "Protocol desync regression test #$c" {
+ set s [socket [srv 0 host] [srv 0 port]]
+ puts -nonewline $s $seq
+ set payload [string repeat A 1024]"\n"
+ set test_start [clock seconds]
+ set test_time_limit 30
+ while 1 {
+ if {[catch {
+ puts -nonewline $s payload
+ flush $s
+ incr payload_size [string length $payload]
+ }]} {
+ set retval [gets $s]
+ close $s
+ break
+ } else {
+ set elapsed [expr {[clock seconds]-$test_start}]
+ if {$elapsed > $test_time_limit} {
+ close $s
+ error "assertion:Redis did not closed connection after protocol desync"
+ }
+ }
+ }
+ set retval
+ } {*Protocol error*}
+ }
+ unset c
+}
+
+start_server {tags {"regression"}} {
+ test "Regression for a crash with blocking ops and pipelining" {
+ set rd [redis_deferring_client]
+ set fd [r channel]
+ set proto "*3\r\n\$5\r\nBLPOP\r\n\$6\r\nnolist\r\n\$1\r\n0\r\n"
+ puts -nonewline $fd $proto$proto
+ flush $fd
+ set res {}
+
+ $rd rpush nolist a
+ $rd read
+ $rd rpush nolist a
+ $rd read
+ }
+}
diff --git a/tests/unit/pubsub.tcl b/tests/unit/pubsub.tcl
new file mode 100644
index 0000000..9c7a43b
--- /dev/null
+++ b/tests/unit/pubsub.tcl
@@ -0,0 +1,390 @@
+start_server {tags {"pubsub"}} {
+ proc __consume_subscribe_messages {client type channels} {
+ set numsub -1
+ set counts {}
+
+ for {set i [llength $channels]} {$i > 0} {incr i -1} {
+ set msg [$client read]
+ assert_equal $type [lindex $msg 0]
+
+ # when receiving subscribe messages the channels names
+ # are ordered. when receiving unsubscribe messages
+ # they are unordered
+ set idx [lsearch -exact $channels [lindex $msg 1]]
+ if {[string match "*unsubscribe" $type]} {
+ assert {$idx >= 0}
+ } else {
+ assert {$idx == 0}
+ }
+ set channels [lreplace $channels $idx $idx]
+
+ # aggregate the subscription count to return to the caller
+ lappend counts [lindex $msg 2]
+ }
+
+ # we should have received messages for channels
+ assert {[llength $channels] == 0}
+ return $counts
+ }
+
+ proc subscribe {client channels} {
+ $client subscribe {*}$channels
+ __consume_subscribe_messages $client subscribe $channels
+ }
+
+ proc unsubscribe {client {channels {}}} {
+ $client unsubscribe {*}$channels
+ __consume_subscribe_messages $client unsubscribe $channels
+ }
+
+ proc psubscribe {client channels} {
+ $client psubscribe {*}$channels
+ __consume_subscribe_messages $client psubscribe $channels
+ }
+
+ proc punsubscribe {client {channels {}}} {
+ $client punsubscribe {*}$channels
+ __consume_subscribe_messages $client punsubscribe $channels
+ }
+
+ test "Pub/Sub PING" {
+ set rd1 [redis_deferring_client]
+ subscribe $rd1 somechannel
+ # While subscribed to non-zero channels PING works in Pub/Sub mode.
+ $rd1 ping
+ $rd1 ping "foo"
+ set reply1 [$rd1 read]
+ set reply2 [$rd1 read]
+ unsubscribe $rd1 somechannel
+ # Now we are unsubscribed, PING should just return PONG.
+ $rd1 ping
+ set reply3 [$rd1 read]
+ $rd1 close
+ list $reply1 $reply2 $reply3
+ } {{pong {}} {pong foo} PONG}
+
+ test "PUBLISH/SUBSCRIBE basics" {
+ set rd1 [redis_deferring_client]
+
+ # subscribe to two channels
+ assert_equal {1 2} [subscribe $rd1 {chan1 chan2}]
+ assert_equal 1 [r publish chan1 hello]
+ assert_equal 1 [r publish chan2 world]
+ assert_equal {message chan1 hello} [$rd1 read]
+ assert_equal {message chan2 world} [$rd1 read]
+
+ # unsubscribe from one of the channels
+ unsubscribe $rd1 {chan1}
+ assert_equal 0 [r publish chan1 hello]
+ assert_equal 1 [r publish chan2 world]
+ assert_equal {message chan2 world} [$rd1 read]
+
+ # unsubscribe from the remaining channel
+ unsubscribe $rd1 {chan2}
+ assert_equal 0 [r publish chan1 hello]
+ assert_equal 0 [r publish chan2 world]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "PUBLISH/SUBSCRIBE with two clients" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+
+ assert_equal {1} [subscribe $rd1 {chan1}]
+ assert_equal {1} [subscribe $rd2 {chan1}]
+ assert_equal 2 [r publish chan1 hello]
+ assert_equal {message chan1 hello} [$rd1 read]
+ assert_equal {message chan1 hello} [$rd2 read]
+
+ # clean up clients
+ $rd1 close
+ $rd2 close
+ }
+
+ test "PUBLISH/SUBSCRIBE after UNSUBSCRIBE without arguments" {
+ set rd1 [redis_deferring_client]
+ assert_equal {1 2 3} [subscribe $rd1 {chan1 chan2 chan3}]
+ unsubscribe $rd1
+ assert_equal 0 [r publish chan1 hello]
+ assert_equal 0 [r publish chan2 hello]
+ assert_equal 0 [r publish chan3 hello]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "SUBSCRIBE to one channel more than once" {
+ set rd1 [redis_deferring_client]
+ assert_equal {1 1 1} [subscribe $rd1 {chan1 chan1 chan1}]
+ assert_equal 1 [r publish chan1 hello]
+ assert_equal {message chan1 hello} [$rd1 read]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "UNSUBSCRIBE from non-subscribed channels" {
+ set rd1 [redis_deferring_client]
+ assert_equal {0 0 0} [unsubscribe $rd1 {foo bar quux}]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "PUBLISH/PSUBSCRIBE basics" {
+ set rd1 [redis_deferring_client]
+
+ # subscribe to two patterns
+ assert_equal {1 2} [psubscribe $rd1 {foo.* bar.*}]
+ assert_equal 1 [r publish foo.1 hello]
+ assert_equal 1 [r publish bar.1 hello]
+ assert_equal 0 [r publish foo1 hello]
+ assert_equal 0 [r publish barfoo.1 hello]
+ assert_equal 0 [r publish qux.1 hello]
+ assert_equal {pmessage foo.* foo.1 hello} [$rd1 read]
+ assert_equal {pmessage bar.* bar.1 hello} [$rd1 read]
+
+ # unsubscribe from one of the patterns
+ assert_equal {1} [punsubscribe $rd1 {foo.*}]
+ assert_equal 0 [r publish foo.1 hello]
+ assert_equal 1 [r publish bar.1 hello]
+ assert_equal {pmessage bar.* bar.1 hello} [$rd1 read]
+
+ # unsubscribe from the remaining pattern
+ assert_equal {0} [punsubscribe $rd1 {bar.*}]
+ assert_equal 0 [r publish foo.1 hello]
+ assert_equal 0 [r publish bar.1 hello]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "PUBLISH/PSUBSCRIBE with two clients" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+
+ assert_equal {1} [psubscribe $rd1 {chan.*}]
+ assert_equal {1} [psubscribe $rd2 {chan.*}]
+ assert_equal 2 [r publish chan.foo hello]
+ assert_equal {pmessage chan.* chan.foo hello} [$rd1 read]
+ assert_equal {pmessage chan.* chan.foo hello} [$rd2 read]
+
+ # clean up clients
+ $rd1 close
+ $rd2 close
+ }
+
+ test "PUBLISH/PSUBSCRIBE after PUNSUBSCRIBE without arguments" {
+ set rd1 [redis_deferring_client]
+ assert_equal {1 2 3} [psubscribe $rd1 {chan1.* chan2.* chan3.*}]
+ punsubscribe $rd1
+ assert_equal 0 [r publish chan1.hi hello]
+ assert_equal 0 [r publish chan2.hi hello]
+ assert_equal 0 [r publish chan3.hi hello]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "PUNSUBSCRIBE from non-subscribed channels" {
+ set rd1 [redis_deferring_client]
+ assert_equal {0 0 0} [punsubscribe $rd1 {foo.* bar.* quux.*}]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "NUMSUB returns numbers, not strings (#1561)" {
+ r pubsub numsub abc def
+ } {abc 0 def 0}
+
+ test "Mix SUBSCRIBE and PSUBSCRIBE" {
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [subscribe $rd1 {foo.bar}]
+ assert_equal {2} [psubscribe $rd1 {foo.*}]
+
+ assert_equal 2 [r publish foo.bar hello]
+ assert_equal {message foo.bar hello} [$rd1 read]
+ assert_equal {pmessage foo.* foo.bar hello} [$rd1 read]
+
+ # clean up clients
+ $rd1 close
+ }
+
+ test "PUNSUBSCRIBE and UNSUBSCRIBE should always reply" {
+ # Make sure we are not subscribed to any channel at all.
+ r punsubscribe
+ r unsubscribe
+ # Now check if the commands still reply correctly.
+ set reply1 [r punsubscribe]
+ set reply2 [r unsubscribe]
+ concat $reply1 $reply2
+ } {punsubscribe {} 0 unsubscribe {} 0}
+
+ ### Keyspace events notification tests
+
+ test "Keyspace notifications: we receive keyspace notifications" {
+ r config set notify-keyspace-events KA
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ assert_equal {pmessage * __keyspace@9__:foo set} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: we receive keyevent notifications" {
+ r config set notify-keyspace-events EA
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ assert_equal {pmessage * __keyevent@9__:set foo} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: we can receive both kind of events" {
+ r config set notify-keyspace-events KEA
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ assert_equal {pmessage * __keyspace@9__:foo set} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:set foo} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: we are able to mask events" {
+ r config set notify-keyspace-events KEl
+ r del mylist
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ r lpush mylist a
+ # No notification for set, because only list commands are enabled.
+ assert_equal {pmessage * __keyspace@9__:mylist lpush} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:lpush mylist} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: general events test" {
+ r config set notify-keyspace-events KEg
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ r expire foo 1
+ r del foo
+ assert_equal {pmessage * __keyspace@9__:foo expire} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:expire foo} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:foo del} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:del foo} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: list events test" {
+ r config set notify-keyspace-events KEl
+ r del mylist
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r lpush mylist a
+ r rpush mylist a
+ r rpop mylist
+ assert_equal {pmessage * __keyspace@9__:mylist lpush} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:lpush mylist} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:mylist rpush} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:rpush mylist} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:mylist rpop} [$rd1 read]
+ assert_equal {pmessage * __keyevent@9__:rpop mylist} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: set events test" {
+ r config set notify-keyspace-events Ks
+ r del myset
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r sadd myset a b c d
+ r srem myset x
+ r sadd myset x y z
+ r srem myset x
+ assert_equal {pmessage * __keyspace@9__:myset sadd} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:myset sadd} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:myset srem} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: zset events test" {
+ r config set notify-keyspace-events Kz
+ r del myzset
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r zadd myzset 1 a 2 b
+ r zrem myzset x
+ r zadd myzset 3 x 4 y 5 z
+ r zrem myzset x
+ assert_equal {pmessage * __keyspace@9__:myzset zadd} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:myzset zadd} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:myzset zrem} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: hash events test" {
+ r config set notify-keyspace-events Kh
+ r del myhash
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r hmset myhash yes 1 no 0
+ r hincrby myhash yes 10
+ assert_equal {pmessage * __keyspace@9__:myhash hset} [$rd1 read]
+ assert_equal {pmessage * __keyspace@9__:myhash hincrby} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: expired events (triggered expire)" {
+ r config set notify-keyspace-events Ex
+ r del foo
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r psetex foo 100 1
+ wait_for_condition 50 100 {
+ [r exists foo] == 0
+ } else {
+ fail "Key does not expire?!"
+ }
+ assert_equal {pmessage * __keyevent@9__:expired foo} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: expired events (background expire)" {
+ r config set notify-keyspace-events Ex
+ r del foo
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r psetex foo 100 1
+ assert_equal {pmessage * __keyevent@9__:expired foo} [$rd1 read]
+ $rd1 close
+ }
+
+ test "Keyspace notifications: evicted events" {
+ r config set notify-keyspace-events Ee
+ r config set maxmemory-policy allkeys-lru
+ r flushdb
+ set rd1 [redis_deferring_client]
+ assert_equal {1} [psubscribe $rd1 *]
+ r set foo bar
+ r config set maxmemory 1
+ assert_equal {pmessage * __keyevent@9__:evicted foo} [$rd1 read]
+ r config set maxmemory 0
+ $rd1 close
+ }
+
+ test "Keyspace notifications: test CONFIG GET/SET of event flags" {
+ r config set notify-keyspace-events gKE
+ assert_equal {gKE} [lindex [r config get notify-keyspace-events] 1]
+ r config set notify-keyspace-events {$lshzxeKE}
+ assert_equal {$lshzxeKE} [lindex [r config get notify-keyspace-events] 1]
+ r config set notify-keyspace-events KA
+ assert_equal {AK} [lindex [r config get notify-keyspace-events] 1]
+ r config set notify-keyspace-events EA
+ assert_equal {AE} [lindex [r config get notify-keyspace-events] 1]
+ }
+}
diff --git a/tests/unit/quit.tcl b/tests/unit/quit.tcl
new file mode 100644
index 0000000..4cf440a
--- /dev/null
+++ b/tests/unit/quit.tcl
@@ -0,0 +1,40 @@
+start_server {tags {"quit"}} {
+ proc format_command {args} {
+ set cmd "*[llength $args]\r\n"
+ foreach a $args {
+ append cmd "$[string length $a]\r\n$a\r\n"
+ }
+ set _ $cmd
+ }
+
+ test "QUIT returns OK" {
+ reconnect
+ assert_equal OK [r quit]
+ assert_error * {r ping}
+ }
+
+ test "Pipelined commands after QUIT must not be executed" {
+ reconnect
+ r write [format_command quit]
+ r write [format_command set foo bar]
+ r flush
+ assert_equal OK [r read]
+ assert_error * {r read}
+
+ reconnect
+ assert_equal {} [r get foo]
+ }
+
+ test "Pipelined commands after QUIT that exceed read buffer size" {
+ reconnect
+ r write [format_command quit]
+ r write [format_command set foo [string repeat "x" 1024]]
+ r flush
+ assert_equal OK [r read]
+ assert_error * {r read}
+
+ reconnect
+ assert_equal {} [r get foo]
+
+ }
+}
diff --git a/tests/unit/scan.tcl b/tests/unit/scan.tcl
new file mode 100644
index 0000000..1d84f12
--- /dev/null
+++ b/tests/unit/scan.tcl
@@ -0,0 +1,239 @@
+start_server {tags {"scan"}} {
+ test "SCAN basic" {
+ r flushdb
+ r debug populate 1000
+
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r scan $cur]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys [lsort -unique $keys]
+ assert_equal 1000 [llength $keys]
+ }
+
+ test "SCAN COUNT" {
+ r flushdb
+ r debug populate 1000
+
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r scan $cur count 5]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys [lsort -unique $keys]
+ assert_equal 1000 [llength $keys]
+ }
+
+ test "SCAN MATCH" {
+ r flushdb
+ r debug populate 1000
+
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r scan $cur match "key:1??"]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys [lsort -unique $keys]
+ assert_equal 100 [llength $keys]
+ }
+
+ foreach enc {intset hashtable} {
+ test "SSCAN with encoding $enc" {
+ # Create the Set
+ r del set
+ if {$enc eq {intset}} {
+ set prefix ""
+ } else {
+ set prefix "ele:"
+ }
+ set elements {}
+ for {set j 0} {$j < 100} {incr j} {
+ lappend elements ${prefix}${j}
+ }
+ r sadd set {*}$elements
+
+ # Verify that the encoding matches.
+ assert {[r object encoding set] eq $enc}
+
+ # Test SSCAN
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r sscan set $cur]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys [lsort -unique $keys]
+ assert_equal 100 [llength $keys]
+ }
+ }
+
+ foreach enc {ziplist hashtable} {
+ test "HSCAN with encoding $enc" {
+ # Create the Hash
+ r del hash
+ if {$enc eq {ziplist}} {
+ set count 30
+ } else {
+ set count 1000
+ }
+ set elements {}
+ for {set j 0} {$j < $count} {incr j} {
+ lappend elements key:$j $j
+ }
+ r hmset hash {*}$elements
+
+ # Verify that the encoding matches.
+ assert {[r object encoding hash] eq $enc}
+
+ # Test HSCAN
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r hscan hash $cur]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys2 {}
+ foreach {k v} $keys {
+ assert {$k eq "key:$v"}
+ lappend keys2 $k
+ }
+
+ set keys2 [lsort -unique $keys2]
+ assert_equal $count [llength $keys2]
+ }
+ }
+
+ foreach enc {ziplist skiplist} {
+ test "ZSCAN with encoding $enc" {
+ # Create the Sorted Set
+ r del zset
+ if {$enc eq {ziplist}} {
+ set count 30
+ } else {
+ set count 1000
+ }
+ set elements {}
+ for {set j 0} {$j < $count} {incr j} {
+ lappend elements $j key:$j
+ }
+ r zadd zset {*}$elements
+
+ # Verify that the encoding matches.
+ assert {[r object encoding zset] eq $enc}
+
+ # Test ZSCAN
+ set cur 0
+ set keys {}
+ while 1 {
+ set res [r zscan zset $cur]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ }
+
+ set keys2 {}
+ foreach {k v} $keys {
+ assert {$k eq "key:$v"}
+ lappend keys2 $k
+ }
+
+ set keys2 [lsort -unique $keys2]
+ assert_equal $count [llength $keys2]
+ }
+ }
+
+ test "SCAN guarantees check under write load" {
+ r flushdb
+ r debug populate 100
+
+ # We start scanning here, so keys from 0 to 99 should all be
+ # reported at the end of the iteration.
+ set keys {}
+ while 1 {
+ set res [r scan $cur]
+ set cur [lindex $res 0]
+ set k [lindex $res 1]
+ lappend keys {*}$k
+ if {$cur == 0} break
+ # Write 10 random keys at every SCAN iteration.
+ for {set j 0} {$j < 10} {incr j} {
+ r set addedkey:[randomInt 1000] foo
+ }
+ }
+
+ set keys2 {}
+ foreach k $keys {
+ if {[string length $k] > 6} continue
+ lappend keys2 $k
+ }
+
+ set keys2 [lsort -unique $keys2]
+ assert_equal 100 [llength $keys2]
+ }
+
+ test "SSCAN with integer encoded object (issue #1345)" {
+ set objects {1 a}
+ r del set
+ r sadd set {*}$objects
+ set res [r sscan set 0 MATCH *a* COUNT 100]
+ assert_equal [lsort -unique [lindex $res 1]] {a}
+ set res [r sscan set 0 MATCH *1* COUNT 100]
+ assert_equal [lsort -unique [lindex $res 1]] {1}
+ }
+
+ test "SSCAN with PATTERN" {
+ r del mykey
+ r sadd mykey foo fab fiz foobar 1 2 3 4
+ set res [r sscan mykey 0 MATCH foo* COUNT 10000]
+ lsort -unique [lindex $res 1]
+ } {foo foobar}
+
+ test "HSCAN with PATTERN" {
+ r del mykey
+ r hmset mykey foo 1 fab 2 fiz 3 foobar 10 1 a 2 b 3 c 4 d
+ set res [r hscan mykey 0 MATCH foo* COUNT 10000]
+ lsort -unique [lindex $res 1]
+ } {1 10 foo foobar}
+
+ test "ZSCAN with PATTERN" {
+ r del mykey
+ r zadd mykey 1 foo 2 fab 3 fiz 10 foobar
+ set res [r zscan mykey 0 MATCH foo* COUNT 10000]
+ lsort -unique [lindex $res 1]
+ }
+
+ test "ZSCAN scores: regression test for issue #2175" {
+ r del mykey
+ for {set j 0} {$j < 500} {incr j} {
+ r zadd mykey 9.8813129168249309e-323 $j
+ }
+ set res [lindex [r zscan mykey 0] 1]
+ set first_score [lindex $res 1]
+ assert {$first_score != 0}
+ }
+}
diff --git a/tests/unit/scripting.tcl b/tests/unit/scripting.tcl
new file mode 100644
index 0000000..be82e15
--- /dev/null
+++ b/tests/unit/scripting.tcl
@@ -0,0 +1,735 @@
+start_server {tags {"scripting"}} {
+ test {EVAL - Does Lua interpreter replies to our requests?} {
+ r eval {return 'hello'} 0
+ } {hello}
+
+ test {EVAL - Lua integer -> Redis protocol type conversion} {
+ r eval {return 100.5} 0
+ } {100}
+
+ test {EVAL - Lua string -> Redis protocol type conversion} {
+ r eval {return 'hello world'} 0
+ } {hello world}
+
+ test {EVAL - Lua true boolean -> Redis protocol type conversion} {
+ r eval {return true} 0
+ } {1}
+
+ test {EVAL - Lua false boolean -> Redis protocol type conversion} {
+ r eval {return false} 0
+ } {}
+
+ test {EVAL - Lua status code reply -> Redis protocol type conversion} {
+ r eval {return {ok='fine'}} 0
+ } {fine}
+
+ test {EVAL - Lua error reply -> Redis protocol type conversion} {
+ catch {
+ r eval {return {err='this is an error'}} 0
+ } e
+ set _ $e
+ } {this is an error}
+
+ test {EVAL - Lua table -> Redis protocol type conversion} {
+ r eval {return {1,2,3,'ciao',{1,2}}} 0
+ } {1 2 3 ciao {1 2}}
+
+ test {EVAL - Are the KEYS and ARGV arrays populated correctly?} {
+ r eval {return {KEYS[1],KEYS[2],ARGV[1],ARGV[2]}} 2 a b c d
+ } {a b c d}
+
+ test {EVAL - is Lua able to call Redis API?} {
+ r set mykey myval
+ r eval {return redis.call('get',KEYS[1])} 1 mykey
+ } {myval}
+
+ test {EVALSHA - Can we call a SHA1 if already defined?} {
+ r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey
+ } {myval}
+
+ test {EVALSHA - Can we call a SHA1 in uppercase?} {
+ r evalsha FD758D1589D044DD850A6F05D52F2EEFD27F033F 1 mykey
+ } {myval}
+
+ test {EVALSHA - Do we get an error on invalid SHA1?} {
+ catch {r evalsha NotValidShaSUM 0} e
+ set _ $e
+ } {NOSCRIPT*}
+
+ test {EVALSHA - Do we get an error on non defined SHA1?} {
+ catch {r evalsha ffd632c7d33e571e9f24556ebed26c3479a87130 0} e
+ set _ $e
+ } {NOSCRIPT*}
+
+ test {EVAL - Redis integer -> Lua type conversion} {
+ r set x 0
+ r eval {
+ local foo = redis.pcall('incr',KEYS[1])
+ return {type(foo),foo}
+ } 1 x
+ } {number 1}
+
+ test {EVAL - Redis bulk -> Lua type conversion} {
+ r set mykey myval
+ r eval {
+ local foo = redis.pcall('get',KEYS[1])
+ return {type(foo),foo}
+ } 1 mykey
+ } {string myval}
+
+ test {EVAL - Redis multi bulk -> Lua type conversion} {
+ r del mylist
+ r rpush mylist a
+ r rpush mylist b
+ r rpush mylist c
+ r eval {
+ local foo = redis.pcall('lrange',KEYS[1],0,-1)
+ return {type(foo),foo[1],foo[2],foo[3],# foo}
+ } 1 mylist
+ } {table a b c 3}
+
+ test {EVAL - Redis status reply -> Lua type conversion} {
+ r eval {
+ local foo = redis.pcall('set',KEYS[1],'myval')
+ return {type(foo),foo['ok']}
+ } 1 mykey
+ } {table OK}
+
+ test {EVAL - Redis error reply -> Lua type conversion} {
+ r set mykey myval
+ r eval {
+ local foo = redis.pcall('incr',KEYS[1])
+ return {type(foo),foo['err']}
+ } 1 mykey
+ } {table {ERR value is not an integer or out of range}}
+
+ test {EVAL - Redis nil bulk reply -> Lua type conversion} {
+ r del mykey
+ r eval {
+ local foo = redis.pcall('get',KEYS[1])
+ return {type(foo),foo == false}
+ } 1 mykey
+ } {boolean 1}
+
+ test {EVAL - Is the Lua client using the currently selected DB?} {
+ r set mykey "this is DB 9"
+ r select 10
+ r set mykey "this is DB 10"
+ r eval {return redis.pcall('get',KEYS[1])} 1 mykey
+ } {this is DB 10}
+
+ test {EVAL - SELECT inside Lua should not affect the caller} {
+ # here we DB 10 is selected
+ r set mykey "original value"
+ r eval {return redis.pcall('select','9')} 0
+ set res [r get mykey]
+ r select 9
+ set res
+ } {original value}
+
+ if 0 {
+ test {EVAL - Script can't run more than configured time limit} {
+ r config set lua-time-limit 1
+ catch {
+ r eval {
+ local i = 0
+ while true do i=i+1 end
+ } 0
+ } e
+ set _ $e
+ } {*execution time*}
+ }
+
+ test {EVAL - Scripts can't run certain commands} {
+ set e {}
+ catch {r eval {return redis.pcall('blpop','x',0)} 0} e
+ set e
+ } {*not allowed*}
+
+ test {EVAL - Scripts can't run certain commands} {
+ set e {}
+ catch {
+ r eval "redis.pcall('randomkey'); return redis.pcall('set','x','ciao')" 0
+ } e
+ set e
+ } {*not allowed after*}
+
+ test {EVAL - No arguments to redis.call/pcall is considered an error} {
+ set e {}
+ catch {r eval {return redis.call()} 0} e
+ set e
+ } {*one argument*}
+
+ test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} {
+ set e {}
+ catch {
+ r eval "redis.call('nosuchcommand')" 0
+ } e
+ set e
+ } {*Unknown Redis*}
+
+ test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} {
+ set e {}
+ catch {
+ r eval "redis.call('get','a','b','c')" 0
+ } e
+ set e
+ } {*number of args*}
+
+ test {EVAL - redis.call variant raises a Lua error on Redis cmd error (1)} {
+ set e {}
+ r set foo bar
+ catch {
+ r eval {redis.call('lpush',KEYS[1],'val')} 1 foo
+ } e
+ set e
+ } {*against a key*}
+
+ test {EVAL - JSON numeric decoding} {
+ # We must return the table as a string because otherwise
+ # Redis converts floats to ints and we get 0 and 1023 instead
+ # of 0.0003 and 1023.2 as the parsed output.
+ r eval {return
+ table.concat(
+ cjson.decode(
+ "[0.0, -5e3, -1, 0.3e-3, 1023.2, 0e10]"), " ")
+ } 0
+ } {0 -5000 -1 0.0003 1023.2 0}
+
+ test {EVAL - JSON string decoding} {
+ r eval {local decoded = cjson.decode('{"keya": "a", "keyb": "b"}')
+ return {decoded.keya, decoded.keyb}
+ } 0
+ } {a b}
+
+ test {EVAL - cmsgpack can pack double?} {
+ r eval {local encoded = cmsgpack.pack(0.1)
+ local h = ""
+ for i = 1, #encoded do
+ h = h .. string.format("%02x",string.byte(encoded,i))
+ end
+ return h
+ } 0
+ } {cb3fb999999999999a}
+
+ test {EVAL - cmsgpack can pack negative int64?} {
+ r eval {local encoded = cmsgpack.pack(-1099511627776)
+ local h = ""
+ for i = 1, #encoded do
+ h = h .. string.format("%02x",string.byte(encoded,i))
+ end
+ return h
+ } 0
+ } {d3ffffff0000000000}
+
+ test {EVAL - cmsgpack can pack and unpack circular references?} {
+ r eval {local a = {x=nil,y=5}
+ local b = {x=a}
+ a['x'] = b
+ local encoded = cmsgpack.pack(a)
+ local h = ""
+ -- cmsgpack encodes to a depth of 16, but can't encode
+ -- references, so the encoded object has a deep copy recusive
+ -- depth of 16.
+ for i = 1, #encoded do
+ h = h .. string.format("%02x",string.byte(encoded,i))
+ end
+ -- when unpacked, re.x.x != re because the unpack creates
+ -- individual tables down to a depth of 16.
+ -- (that's why the encoded output is so large)
+ local re = cmsgpack.unpack(encoded)
+ assert(re)
+ assert(re.x)
+ assert(re.x.x.y == re.y)
+ assert(re.x.x.x.x.y == re.y)
+ assert(re.x.x.x.x.x.x.y == re.y)
+ assert(re.x.x.x.x.x.x.x.x.x.x.y == re.y)
+ -- maximum working depth:
+ assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.y == re.y)
+ -- now the last x would be b above and has no y
+ assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x)
+ -- so, the final x.x is at the depth limit and was assigned nil
+ assert(re.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x == nil)
+ return {h, re.x.x.x.x.x.x.x.x.y == re.y, re.y == 5}
+ } 0
+ } {82a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a17882a17905a17881a178c0 1 1}
+
+ test {EVAL - Numerical sanity check from bitop} {
+ r eval {assert(0x7fffffff == 2147483647, "broken hex literals");
+ assert(0xffffffff == -1 or 0xffffffff == 2^32-1,
+ "broken hex literals");
+ assert(tostring(-1) == "-1", "broken tostring()");
+ assert(tostring(0xffffffff) == "-1" or
+ tostring(0xffffffff) == "4294967295",
+ "broken tostring()")
+ } 0
+ } {}
+
+ test {EVAL - Verify minimal bitop functionality} {
+ r eval {assert(bit.tobit(1) == 1);
+ assert(bit.band(1) == 1);
+ assert(bit.bxor(1,2) == 3);
+ assert(bit.bor(1,2,4,8,16,32,64,128) == 255)
+ } 0
+ } {}
+
+ test {EVAL - Able to parse trailing comments} {
+ r eval {return 'hello' --trailing comment} 0
+ } {hello}
+
+ test {SCRIPTING FLUSH - is able to clear the scripts cache?} {
+ r set mykey myval
+ set v [r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey]
+ assert_equal $v myval
+ set e ""
+ r script flush
+ catch {r evalsha fd758d1589d044dd850a6f05d52f2eefd27f033f 1 mykey} e
+ set e
+ } {NOSCRIPT*}
+
+ test {SCRIPT EXISTS - can detect already defined scripts?} {
+ r eval "return 1+1" 0
+ r script exists a27e7e8a43702b7046d4f6a7ccf5b60cef6b9bd9 a27e7e8a43702b7046d4f6a7ccf5b60cef6b9bda
+ } {1 0}
+
+ test {SCRIPT LOAD - is able to register scripts in the scripting cache} {
+ list \
+ [r script load "return 'loaded'"] \
+ [r evalsha b534286061d4b9e4026607613b95c06c06015ae8 0]
+ } {b534286061d4b9e4026607613b95c06c06015ae8 loaded}
+
+ test "In the context of Lua the output of random commands gets ordered" {
+ r del myset
+ r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz
+ r eval {return redis.call('smembers',KEYS[1])} 1 myset
+ } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z}
+
+ test "SORT is normally not alpha re-ordered for the scripting engine" {
+ r del myset
+ r sadd myset 1 2 3 4 10
+ r eval {return redis.call('sort',KEYS[1],'desc')} 1 myset
+ } {10 4 3 2 1}
+
+ test "SORT BY <constant> output gets ordered for scripting" {
+ r del myset
+ r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz
+ r eval {return redis.call('sort',KEYS[1],'by','_')} 1 myset
+ } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z}
+
+ test "SORT BY <constant> with GET gets ordered for scripting" {
+ r del myset
+ r sadd myset a b c
+ r eval {return redis.call('sort',KEYS[1],'by','_','get','#','get','_:*')} 1 myset
+ } {a {} b {} c {}}
+
+ test "redis.sha1hex() implementation" {
+ list [r eval {return redis.sha1hex('')} 0] \
+ [r eval {return redis.sha1hex('Pizza & Mandolino')} 0]
+ } {da39a3ee5e6b4b0d3255bfef95601890afd80709 74822d82031af7493c20eefa13bd07ec4fada82f}
+
+ test {Globals protection reading an undeclared global variable} {
+ catch {r eval {return a} 0} e
+ set e
+ } {*ERR*attempted to access * global*}
+
+ test {Globals protection setting an undeclared global*} {
+ catch {r eval {a=10} 0} e
+ set e
+ } {*ERR*attempted to create global*}
+
+ test {Test an example script DECR_IF_GT} {
+ set decr_if_gt {
+ local current
+
+ current = redis.call('get',KEYS[1])
+ if not current then return nil end
+ if current > ARGV[1] then
+ return redis.call('decr',KEYS[1])
+ else
+ return redis.call('get',KEYS[1])
+ end
+ }
+ r set foo 5
+ set res {}
+ lappend res [r eval $decr_if_gt 1 foo 2]
+ lappend res [r eval $decr_if_gt 1 foo 2]
+ lappend res [r eval $decr_if_gt 1 foo 2]
+ lappend res [r eval $decr_if_gt 1 foo 2]
+ lappend res [r eval $decr_if_gt 1 foo 2]
+ set res
+ } {4 3 2 2 2}
+
+ test {Scripting engine resets PRNG at every script execution} {
+ set rand1 [r eval {return tostring(math.random())} 0]
+ set rand2 [r eval {return tostring(math.random())} 0]
+ assert_equal $rand1 $rand2
+ }
+
+ test {Scripting engine PRNG can be seeded correctly} {
+ set rand1 [r eval {
+ math.randomseed(ARGV[1]); return tostring(math.random())
+ } 0 10]
+ set rand2 [r eval {
+ math.randomseed(ARGV[1]); return tostring(math.random())
+ } 0 10]
+ set rand3 [r eval {
+ math.randomseed(ARGV[1]); return tostring(math.random())
+ } 0 20]
+ assert_equal $rand1 $rand2
+ assert {$rand2 ne $rand3}
+ }
+
+ test {EVAL does not leak in the Lua stack} {
+ r set x 0
+ # Use a non blocking client to speedup the loop.
+ set rd [redis_deferring_client]
+ for {set j 0} {$j < 10000} {incr j} {
+ $rd eval {return redis.call("incr",KEYS[1])} 1 x
+ }
+ for {set j 0} {$j < 10000} {incr j} {
+ $rd read
+ }
+ assert {[s used_memory_lua] < 1024*100}
+ $rd close
+ r get x
+ } {10000}
+
+ test {EVAL processes writes from AOF in read-only slaves} {
+ r flushall
+ r config set appendonly yes
+ r eval {redis.call("set",KEYS[1],"100")} 1 foo
+ r eval {redis.call("incr",KEYS[1])} 1 foo
+ r eval {redis.call("incr",KEYS[1])} 1 foo
+ wait_for_condition 50 100 {
+ [s aof_rewrite_in_progress] == 0
+ } else {
+ fail "AOF rewrite can't complete after CONFIG SET appendonly yes."
+ }
+ r config set slave-read-only yes
+ r slaveof 127.0.0.1 0
+ r debug loadaof
+ set res [r get foo]
+ r slaveof no one
+ set res
+ } {102}
+
+ test {We can call scripts rewriting client->argv from Lua} {
+ r del myset
+ r sadd myset a b c
+ r mset a 1 b 2 c 3 d 4
+ assert {[r spop myset] ne {}}
+ assert {[r spop myset 1] ne {}}
+ assert {[r spop myset] ne {}}
+ assert {[r mget a b c d] eq {1 2 3 4}}
+ assert {[r spop myset] eq {}}
+ }
+
+ test {Call Redis command with many args from Lua (issue #1764)} {
+ r eval {
+ local i
+ local x={}
+ redis.call('del','mylist')
+ for i=1,100 do
+ table.insert(x,i)
+ end
+ redis.call('rpush','mylist',unpack(x))
+ return redis.call('lrange','mylist',0,-1)
+ } 0
+ } {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100}
+
+ test {Number conversion precision test (issue #1118)} {
+ r eval {
+ local value = 9007199254740991
+ redis.call("set","foo",value)
+ return redis.call("get","foo")
+ } 0
+ } {9007199254740991}
+
+ test {String containing number precision test (regression of issue #1118)} {
+ r eval {
+ redis.call("set", "key", "12039611435714932082")
+ return redis.call("get", "key")
+ } 0
+ } {12039611435714932082}
+
+ test {Verify negative arg count is error instead of crash (issue #1842)} {
+ catch { r eval { return "hello" } -12 } e
+ set e
+ } {ERR Number of keys can't be negative}
+
+ test {Correct handling of reused argv (issue #1939)} {
+ r eval {
+ for i = 0, 10 do
+ redis.call('SET', 'a', '1')
+ redis.call('MGET', 'a', 'b', 'c')
+ redis.call('EXPIRE', 'a', 0)
+ redis.call('GET', 'a')
+ redis.call('MGET', 'a', 'b', 'c')
+ end
+ } 0
+ }
+
+ test {Functions in the Redis namespace are able to report errors} {
+ catch {
+ r eval {
+ redis.sha1hex()
+ } 0
+ } e
+ set e
+ } {*wrong number*}
+}
+
+# Start a new server since the last test in this stanza will kill the
+# instance at all.
+start_server {tags {"scripting"}} {
+ test {Timedout read-only scripts can be killed by SCRIPT KILL} {
+ set rd [redis_deferring_client]
+ r config set lua-time-limit 10
+ $rd eval {while true do end} 0
+ after 200
+ catch {r ping} e
+ assert_match {BUSY*} $e
+ r script kill
+ after 200 ; # Give some time to Lua to call the hook again...
+ assert_equal [r ping] "PONG"
+ }
+
+ test {Timedout script link is still usable after Lua returns} {
+ r config set lua-time-limit 10
+ r eval {for i=1,100000 do redis.call('ping') end return 'ok'} 0
+ r ping
+ } {PONG}
+
+ test {Timedout scripts that modified data can't be killed by SCRIPT KILL} {
+ set rd [redis_deferring_client]
+ r config set lua-time-limit 10
+ $rd eval {redis.call('set',KEYS[1],'y'); while true do end} 1 x
+ after 200
+ catch {r ping} e
+ assert_match {BUSY*} $e
+ catch {r script kill} e
+ assert_match {UNKILLABLE*} $e
+ catch {r ping} e
+ assert_match {BUSY*} $e
+ }
+
+ # Note: keep this test at the end of this server stanza because it
+ # kills the server.
+ test {SHUTDOWN NOSAVE can kill a timedout script anyway} {
+ # The server sould be still unresponding to normal commands.
+ catch {r ping} e
+ assert_match {BUSY*} $e
+ catch {r shutdown nosave}
+ # Make sure the server was killed
+ catch {set rd [redis_deferring_client]} e
+ assert_match {*connection refused*} $e
+ }
+}
+
+foreach cmdrepl {0 1} {
+ start_server {tags {"scripting repl"}} {
+ start_server {} {
+ if {$cmdrepl == 1} {
+ set rt "(commmands replication)"
+ } else {
+ set rt "(scripts replication)"
+ r debug lua-always-replicate-commands 1
+ }
+
+ test "Before the slave connects we issue two EVAL commands $rt" {
+ # One with an error, but still executing a command.
+ # SHA is: 67164fc43fa971f76fd1aaeeaf60c1c178d25876
+ catch {
+ r eval {redis.call('incr',KEYS[1]); redis.call('nonexisting')} 1 x
+ }
+ # One command is correct:
+ # SHA is: 6f5ade10a69975e903c6d07b10ea44c6382381a5
+ r eval {return redis.call('incr',KEYS[1])} 1 x
+ } {2}
+
+ test "Connect a slave to the master instance $rt" {
+ r -1 slaveof [srv 0 host] [srv 0 port]
+ wait_for_condition 50 100 {
+ [s -1 role] eq {slave} &&
+ [string match {*master_link_status:up*} [r -1 info replication]]
+ } else {
+ fail "Can't turn the instance into a slave"
+ }
+ }
+
+ test "Now use EVALSHA against the master, with both SHAs $rt" {
+ # The server should replicate successful and unsuccessful
+ # commands as EVAL instead of EVALSHA.
+ catch {
+ r evalsha 67164fc43fa971f76fd1aaeeaf60c1c178d25876 1 x
+ }
+ r evalsha 6f5ade10a69975e903c6d07b10ea44c6382381a5 1 x
+ } {4}
+
+ test "If EVALSHA was replicated as EVAL, 'x' should be '4' $rt" {
+ wait_for_condition 50 100 {
+ [r -1 get x] eq {4}
+ } else {
+ fail "Expected 4 in x, but value is '[r -1 get x]'"
+ }
+ }
+
+ test "Replication of script multiple pushes to list with BLPOP $rt" {
+ set rd [redis_deferring_client]
+ $rd brpop a 0
+ r eval {
+ redis.call("lpush",KEYS[1],"1");
+ redis.call("lpush",KEYS[1],"2");
+ } 1 a
+ set res [$rd read]
+ $rd close
+ wait_for_condition 50 100 {
+ [r -1 lrange a 0 -1] eq [r lrange a 0 -1]
+ } else {
+ fail "Expected list 'a' in slave and master to be the same, but they are respectively '[r -1 lrange a 0 -1]' and '[r lrange a 0 -1]'"
+ }
+ set res
+ } {a 1}
+
+ test "EVALSHA replication when first call is readonly $rt" {
+ r del x
+ r eval {if tonumber(ARGV[1]) > 0 then redis.call('incr', KEYS[1]) end} 1 x 0
+ r evalsha 6e0e2745aa546d0b50b801a20983b70710aef3ce 1 x 0
+ r evalsha 6e0e2745aa546d0b50b801a20983b70710aef3ce 1 x 1
+ wait_for_condition 50 100 {
+ [r -1 get x] eq {1}
+ } else {
+ fail "Expected 1 in x, but value is '[r -1 get x]'"
+ }
+ }
+
+ test "Lua scripts using SELECT are replicated correctly $rt" {
+ r eval {
+ redis.call("set","foo1","bar1")
+ redis.call("select","10")
+ redis.call("incr","x")
+ redis.call("select","11")
+ redis.call("incr","z")
+ } 0
+ r eval {
+ redis.call("set","foo1","bar1")
+ redis.call("select","10")
+ redis.call("incr","x")
+ redis.call("select","11")
+ redis.call("incr","z")
+ } 0
+ wait_for_condition 50 100 {
+ [r -1 debug digest] eq [r debug digest]
+ } else {
+ fail "Master-Slave desync after Lua script using SELECT."
+ }
+ }
+ }
+ }
+}
+
+start_server {tags {"scripting repl"}} {
+ start_server {overrides {appendonly yes}} {
+ test "Connect a slave to the master instance" {
+ r -1 slaveof [srv 0 host] [srv 0 port]
+ wait_for_condition 50 100 {
+ [s -1 role] eq {slave} &&
+ [string match {*master_link_status:up*} [r -1 info replication]]
+ } else {
+ fail "Can't turn the instance into a slave"
+ }
+ }
+
+ test "Redis.replicate_commands() must be issued before any write" {
+ r eval {
+ redis.call('set','foo','bar');
+ return redis.replicate_commands();
+ } 0
+ } {}
+
+ test "Redis.replicate_commands() must be issued before any write (2)" {
+ r eval {
+ return redis.replicate_commands();
+ } 0
+ } {1}
+
+ test "Redis.set_repl() must be issued after replicate_commands()" {
+ catch {
+ r eval {
+ redis.set_repl(redis.REPL_ALL);
+ } 0
+ } e
+ set e
+ } {*only after turning on*}
+
+ test "Redis.set_repl() don't accept invalid values" {
+ catch {
+ r eval {
+ redis.replicate_commands();
+ redis.set_repl(12345);
+ } 0
+ } e
+ set e
+ } {*Invalid*flags*}
+
+ test "Test selective replication of certain Redis commands from Lua" {
+ r del a b c d
+ r eval {
+ redis.replicate_commands();
+ redis.call('set','a','1');
+ redis.set_repl(redis.REPL_NONE);
+ redis.call('set','b','2');
+ redis.set_repl(redis.REPL_AOF);
+ redis.call('set','c','3');
+ redis.set_repl(redis.REPL_ALL);
+ redis.call('set','d','4');
+ } 0
+
+ wait_for_condition 50 100 {
+ [r -1 mget a b c d] eq {1 {} {} 4}
+ } else {
+ fail "Only a and c should be replicated to slave"
+ }
+
+ # Master should have everything right now
+ assert {[r mget a b c d] eq {1 2 3 4}}
+
+ # After an AOF reload only a, c and d should exist
+ r debug loadaof
+
+ assert {[r mget a b c d] eq {1 {} 3 4}}
+ }
+
+ test "PRNG is seeded randomly for command replication" {
+ set a [
+ r eval {
+ redis.replicate_commands();
+ return math.random()*100000;
+ } 0
+ ]
+ set b [
+ r eval {
+ redis.replicate_commands();
+ return math.random()*100000;
+ } 0
+ ]
+ assert {$a ne $b}
+ }
+
+ test "Using side effects is not a problem with command replication" {
+ r eval {
+ redis.replicate_commands();
+ redis.call('set','time',redis.call('time')[1])
+ } 0
+
+ assert {[r get time] ne {}}
+
+ wait_for_condition 50 100 {
+ [r get time] eq [r -1 get time]
+ } else {
+ fail "Time key does not match between master and slave"
+ }
+ }
+ }
+}
+
diff --git a/tests/unit/slowlog.tcl b/tests/unit/slowlog.tcl
new file mode 100644
index 0000000..b25b91e
--- /dev/null
+++ b/tests/unit/slowlog.tcl
@@ -0,0 +1,70 @@
+start_server {tags {"slowlog"} overrides {slowlog-log-slower-than 1000000}} {
+ test {SLOWLOG - check that it starts with an empty log} {
+ r slowlog len
+ } {0}
+
+ test {SLOWLOG - only logs commands taking more time than specified} {
+ r config set slowlog-log-slower-than 100000
+ r ping
+ assert_equal [r slowlog len] 0
+ r debug sleep 0.2
+ assert_equal [r slowlog len] 1
+ }
+
+ test {SLOWLOG - max entries is correctly handled} {
+ r config set slowlog-log-slower-than 0
+ r config set slowlog-max-len 10
+ for {set i 0} {$i < 100} {incr i} {
+ r ping
+ }
+ r slowlog len
+ } {10}
+
+ test {SLOWLOG - GET optional argument to limit output len works} {
+ llength [r slowlog get 5]
+ } {5}
+
+ test {SLOWLOG - RESET subcommand works} {
+ r config set slowlog-log-slower-than 100000
+ r slowlog reset
+ r slowlog len
+ } {0}
+
+ test {SLOWLOG - logged entry sanity check} {
+ r debug sleep 0.2
+ set e [lindex [r slowlog get] 0]
+ assert_equal [llength $e] 4
+ assert_equal [lindex $e 0] 105
+ assert_equal [expr {[lindex $e 2] > 100000}] 1
+ assert_equal [lindex $e 3] {debug sleep 0.2}
+ }
+
+ test {SLOWLOG - commands with too many arguments are trimmed} {
+ r config set slowlog-log-slower-than 0
+ r slowlog reset
+ r sadd set 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
+ set e [lindex [r slowlog get] 0]
+ lindex $e 3
+ } {sadd set 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 {... (2 more arguments)}}
+
+ test {SLOWLOG - too long arguments are trimmed} {
+ r config set slowlog-log-slower-than 0
+ r slowlog reset
+ set arg [string repeat A 129]
+ r sadd set foo $arg
+ set e [lindex [r slowlog get] 0]
+ lindex $e 3
+ } {sadd set foo {AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA... (1 more bytes)}}
+
+ test {SLOWLOG - EXEC is not logged, just executed commands} {
+ r config set slowlog-log-slower-than 100000
+ r slowlog reset
+ assert_equal [r slowlog len] 0
+ r multi
+ r debug sleep 0.2
+ r exec
+ assert_equal [r slowlog len] 1
+ set e [lindex [r slowlog get] 0]
+ assert_equal [lindex $e 3] {debug sleep 0.2}
+ }
+}
diff --git a/tests/unit/sort.tcl b/tests/unit/sort.tcl
new file mode 100644
index 0000000..083c454
--- /dev/null
+++ b/tests/unit/sort.tcl
@@ -0,0 +1,318 @@
+start_server {
+ tags {"sort"}
+ overrides {
+ "list-max-ziplist-size" 32
+ "set-max-intset-entries" 32
+ }
+} {
+ proc create_random_dataset {num cmd} {
+ set tosort {}
+ set result {}
+ array set seenrand {}
+ r del tosort
+ for {set i 0} {$i < $num} {incr i} {
+ # Make sure all the weights are different because
+ # Redis does not use a stable sort but Tcl does.
+ while 1 {
+ randpath {
+ set rint [expr int(rand()*1000000)]
+ } {
+ set rint [expr rand()]
+ }
+ if {![info exists seenrand($rint)]} break
+ }
+ set seenrand($rint) x
+ r $cmd tosort $i
+ r set weight_$i $rint
+ r hset wobj_$i weight $rint
+ lappend tosort [list $i $rint]
+ }
+ set sorted [lsort -index 1 -real $tosort]
+ for {set i 0} {$i < $num} {incr i} {
+ lappend result [lindex $sorted $i 0]
+ }
+ set _ $result
+ }
+
+ foreach {num cmd enc title} {
+ 16 lpush quicklist "Old Ziplist"
+ 1000 lpush quicklist "Old Linked list"
+ 10000 lpush quicklist "Old Big Linked list"
+ 16 sadd intset "Intset"
+ 1000 sadd hashtable "Hash table"
+ 10000 sadd hashtable "Big Hash table"
+ } {
+ set result [create_random_dataset $num $cmd]
+ assert_encoding $enc tosort
+
+ test "$title: SORT BY key" {
+ assert_equal $result [r sort tosort BY weight_*]
+ }
+
+ test "$title: SORT BY key with limit" {
+ assert_equal [lrange $result 5 9] [r sort tosort BY weight_* LIMIT 5 5]
+ }
+
+ test "$title: SORT BY hash field" {
+ assert_equal $result [r sort tosort BY wobj_*->weight]
+ }
+ }
+
+ set result [create_random_dataset 16 lpush]
+ test "SORT GET #" {
+ assert_equal [lsort -integer $result] [r sort tosort GET #]
+ }
+
+ test "SORT GET <const>" {
+ r del foo
+ set res [r sort tosort GET foo]
+ assert_equal 16 [llength $res]
+ foreach item $res { assert_equal {} $item }
+ }
+
+ test "SORT GET (key and hash) with sanity check" {
+ set l1 [r sort tosort GET # GET weight_*]
+ set l2 [r sort tosort GET # GET wobj_*->weight]
+ foreach {id1 w1} $l1 {id2 w2} $l2 {
+ assert_equal $id1 $id2
+ assert_equal $w1 [r get weight_$id1]
+ assert_equal $w2 [r get weight_$id1]
+ }
+ }
+
+ test "SORT BY key STORE" {
+ r sort tosort BY weight_* store sort-res
+ assert_equal $result [r lrange sort-res 0 -1]
+ assert_equal 16 [r llen sort-res]
+ assert_encoding quicklist sort-res
+ }
+
+ test "SORT BY hash field STORE" {
+ r sort tosort BY wobj_*->weight store sort-res
+ assert_equal $result [r lrange sort-res 0 -1]
+ assert_equal 16 [r llen sort-res]
+ assert_encoding quicklist sort-res
+ }
+
+ test "SORT extracts STORE correctly" {
+ r command getkeys sort abc store def
+ } {abc def}
+
+ test "SORT extracts multiple STORE correctly" {
+ r command getkeys sort abc store invalid store stillbad store def
+ } {abc def}
+
+ test "SORT DESC" {
+ assert_equal [lsort -decreasing -integer $result] [r sort tosort DESC]
+ }
+
+ test "SORT ALPHA against integer encoded strings" {
+ r del mylist
+ r lpush mylist 2
+ r lpush mylist 1
+ r lpush mylist 3
+ r lpush mylist 10
+ r sort mylist alpha
+ } {1 10 2 3}
+
+ test "SORT sorted set" {
+ r del zset
+ r zadd zset 1 a
+ r zadd zset 5 b
+ r zadd zset 2 c
+ r zadd zset 10 d
+ r zadd zset 3 e
+ r sort zset alpha desc
+ } {e d c b a}
+
+ test "SORT sorted set BY nosort should retain ordering" {
+ r del zset
+ r zadd zset 1 a
+ r zadd zset 5 b
+ r zadd zset 2 c
+ r zadd zset 10 d
+ r zadd zset 3 e
+ r multi
+ r sort zset by nosort asc
+ r sort zset by nosort desc
+ r exec
+ } {{a c e b d} {d b e c a}}
+
+ test "SORT sorted set BY nosort + LIMIT" {
+ r del zset
+ r zadd zset 1 a
+ r zadd zset 5 b
+ r zadd zset 2 c
+ r zadd zset 10 d
+ r zadd zset 3 e
+ assert_equal [r sort zset by nosort asc limit 0 1] {a}
+ assert_equal [r sort zset by nosort desc limit 0 1] {d}
+ assert_equal [r sort zset by nosort asc limit 0 2] {a c}
+ assert_equal [r sort zset by nosort desc limit 0 2] {d b}
+ assert_equal [r sort zset by nosort limit 5 10] {}
+ assert_equal [r sort zset by nosort limit -10 100] {a c e b d}
+ }
+
+ test "SORT sorted set BY nosort works as expected from scripts" {
+ r del zset
+ r zadd zset 1 a
+ r zadd zset 5 b
+ r zadd zset 2 c
+ r zadd zset 10 d
+ r zadd zset 3 e
+ r eval {
+ return {redis.call('sort',KEYS[1],'by','nosort','asc'),
+ redis.call('sort',KEYS[1],'by','nosort','desc')}
+ } 1 zset
+ } {{a c e b d} {d b e c a}}
+
+ test "SORT sorted set: +inf and -inf handling" {
+ r del zset
+ r zadd zset -100 a
+ r zadd zset 200 b
+ r zadd zset -300 c
+ r zadd zset 1000000 d
+ r zadd zset +inf max
+ r zadd zset -inf min
+ r zrange zset 0 -1
+ } {min c a b d max}
+
+ test "SORT regression for issue #19, sorting floats" {
+ r flushdb
+ set floats {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}
+ foreach x $floats {
+ r lpush mylist $x
+ }
+ assert_equal [lsort -real $floats] [r sort mylist]
+ }
+
+ test "SORT with STORE returns zero if result is empty (github issue 224)" {
+ r flushdb
+ r sort foo store bar
+ } {0}
+
+ test "SORT with STORE does not create empty lists (github issue 224)" {
+ r flushdb
+ r lpush foo bar
+ r sort foo alpha limit 10 10 store zap
+ r exists zap
+ } {0}
+
+ test "SORT with STORE removes key if result is empty (github issue 227)" {
+ r flushdb
+ r lpush foo bar
+ r sort emptylist store foo
+ r exists foo
+ } {0}
+
+ test "SORT with BY <constant> and STORE should still order output" {
+ r del myset mylist
+ r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz
+ r sort myset alpha by _ store mylist
+ r lrange mylist 0 -1
+ } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z}
+
+ test "SORT will complain with numerical sorting and bad doubles (1)" {
+ r del myset
+ r sadd myset 1 2 3 4 not-a-double
+ set e {}
+ catch {r sort myset} e
+ set e
+ } {*ERR*double*}
+
+ test "SORT will complain with numerical sorting and bad doubles (2)" {
+ r del myset
+ r sadd myset 1 2 3 4
+ r mset score:1 10 score:2 20 score:3 30 score:4 not-a-double
+ set e {}
+ catch {r sort myset by score:*} e
+ set e
+ } {*ERR*double*}
+
+ test "SORT BY sub-sorts lexicographically if score is the same" {
+ r del myset
+ r sadd myset a b c d e f g h i l m n o p q r s t u v z aa aaa azz
+ foreach ele {a aa aaa azz b c d e f g h i l m n o p q r s t u v z} {
+ set score:$ele 100
+ }
+ r sort myset by score:*
+ } {a aa aaa azz b c d e f g h i l m n o p q r s t u v z}
+
+ test "SORT GET with pattern ending with just -> does not get hash field" {
+ r del mylist
+ r lpush mylist a
+ r set x:a-> 100
+ r sort mylist by num get x:*->
+ } {100}
+
+ test "SORT by nosort retains native order for lists" {
+ r del testa
+ r lpush testa 2 1 4 3 5
+ r sort testa by nosort
+ } {5 3 4 1 2}
+
+ test "SORT by nosort plus store retains native order for lists" {
+ r del testa
+ r lpush testa 2 1 4 3 5
+ r sort testa by nosort store testb
+ r lrange testb 0 -1
+ } {5 3 4 1 2}
+
+ test "SORT by nosort with limit returns based on original list order" {
+ r sort testa by nosort limit 0 3 store testb
+ r lrange testb 0 -1
+ } {5 3 4}
+
+ tags {"slow"} {
+ set num 100
+ set res [create_random_dataset $num lpush]
+
+ test "SORT speed, $num element list BY key, 100 times" {
+ set start [clock clicks -milliseconds]
+ for {set i 0} {$i < 100} {incr i} {
+ set sorted [r sort tosort BY weight_* LIMIT 0 10]
+ }
+ set elapsed [expr [clock clicks -milliseconds]-$start]
+ if {$::verbose} {
+ puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
+ flush stdout
+ }
+ }
+
+ test "SORT speed, $num element list BY hash field, 100 times" {
+ set start [clock clicks -milliseconds]
+ for {set i 0} {$i < 100} {incr i} {
+ set sorted [r sort tosort BY wobj_*->weight LIMIT 0 10]
+ }
+ set elapsed [expr [clock clicks -milliseconds]-$start]
+ if {$::verbose} {
+ puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
+ flush stdout
+ }
+ }
+
+ test "SORT speed, $num element list directly, 100 times" {
+ set start [clock clicks -milliseconds]
+ for {set i 0} {$i < 100} {incr i} {
+ set sorted [r sort tosort LIMIT 0 10]
+ }
+ set elapsed [expr [clock clicks -milliseconds]-$start]
+ if {$::verbose} {
+ puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
+ flush stdout
+ }
+ }
+
+ test "SORT speed, $num element list BY <const>, 100 times" {
+ set start [clock clicks -milliseconds]
+ for {set i 0} {$i < 100} {incr i} {
+ set sorted [r sort tosort BY nokey LIMIT 0 10]
+ }
+ set elapsed [expr [clock clicks -milliseconds]-$start]
+ if {$::verbose} {
+ puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds "
+ flush stdout
+ }
+ }
+ }
+}
diff --git a/tests/unit/type/hash.tcl b/tests/unit/type/hash.tcl
new file mode 100644
index 0000000..d2c679d
--- /dev/null
+++ b/tests/unit/type/hash.tcl
@@ -0,0 +1,536 @@
+start_server {tags {"hash"}} {
+ test {HSET/HLEN - Small hash creation} {
+ array set smallhash {}
+ for {set i 0} {$i < 8} {incr i} {
+ set key __avoid_collisions__[randstring 0 8 alpha]
+ set val __avoid_collisions__[randstring 0 8 alpha]
+ if {[info exists smallhash($key)]} {
+ incr i -1
+ continue
+ }
+ r hset smallhash $key $val
+ set smallhash($key) $val
+ }
+ list [r hlen smallhash]
+ } {8}
+
+ test {Is the small hash encoded with a ziplist?} {
+ assert_encoding ziplist smallhash
+ }
+
+ test {HSET/HLEN - Big hash creation} {
+ array set bighash {}
+ for {set i 0} {$i < 1024} {incr i} {
+ set key __avoid_collisions__[randstring 0 8 alpha]
+ set val __avoid_collisions__[randstring 0 8 alpha]
+ if {[info exists bighash($key)]} {
+ incr i -1
+ continue
+ }
+ r hset bighash $key $val
+ set bighash($key) $val
+ }
+ list [r hlen bighash]
+ } {1024}
+
+ test {Is the big hash encoded with an hash table?} {
+ assert_encoding hashtable bighash
+ }
+
+ test {HGET against the small hash} {
+ set err {}
+ foreach k [array names smallhash *] {
+ if {$smallhash($k) ne [r hget smallhash $k]} {
+ set err "$smallhash($k) != [r hget smallhash $k]"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ test {HGET against the big hash} {
+ set err {}
+ foreach k [array names bighash *] {
+ if {$bighash($k) ne [r hget bighash $k]} {
+ set err "$bighash($k) != [r hget bighash $k]"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ test {HGET against non existing key} {
+ set rv {}
+ lappend rv [r hget smallhash __123123123__]
+ lappend rv [r hget bighash __123123123__]
+ set _ $rv
+ } {{} {}}
+
+ test {HSET in update and insert mode} {
+ set rv {}
+ set k [lindex [array names smallhash *] 0]
+ lappend rv [r hset smallhash $k newval1]
+ set smallhash($k) newval1
+ lappend rv [r hget smallhash $k]
+ lappend rv [r hset smallhash __foobar123__ newval]
+ set k [lindex [array names bighash *] 0]
+ lappend rv [r hset bighash $k newval2]
+ set bighash($k) newval2
+ lappend rv [r hget bighash $k]
+ lappend rv [r hset bighash __foobar123__ newval]
+ lappend rv [r hdel smallhash __foobar123__]
+ lappend rv [r hdel bighash __foobar123__]
+ set _ $rv
+ } {0 newval1 1 0 newval2 1 1 1}
+
+ test {HSETNX target key missing - small hash} {
+ r hsetnx smallhash __123123123__ foo
+ r hget smallhash __123123123__
+ } {foo}
+
+ test {HSETNX target key exists - small hash} {
+ r hsetnx smallhash __123123123__ bar
+ set result [r hget smallhash __123123123__]
+ r hdel smallhash __123123123__
+ set _ $result
+ } {foo}
+
+ test {HSETNX target key missing - big hash} {
+ r hsetnx bighash __123123123__ foo
+ r hget bighash __123123123__
+ } {foo}
+
+ test {HSETNX target key exists - big hash} {
+ r hsetnx bighash __123123123__ bar
+ set result [r hget bighash __123123123__]
+ r hdel bighash __123123123__
+ set _ $result
+ } {foo}
+
+ test {HMSET wrong number of args} {
+ catch {r hmset smallhash key1 val1 key2} err
+ format $err
+ } {*wrong number*}
+
+ test {HMSET - small hash} {
+ set args {}
+ foreach {k v} [array get smallhash] {
+ set newval [randstring 0 8 alpha]
+ set smallhash($k) $newval
+ lappend args $k $newval
+ }
+ r hmset smallhash {*}$args
+ } {OK}
+
+ test {HMSET - big hash} {
+ set args {}
+ foreach {k v} [array get bighash] {
+ set newval [randstring 0 8 alpha]
+ set bighash($k) $newval
+ lappend args $k $newval
+ }
+ r hmset bighash {*}$args
+ } {OK}
+
+ test {HMGET against non existing key and fields} {
+ set rv {}
+ lappend rv [r hmget doesntexist __123123123__ __456456456__]
+ lappend rv [r hmget smallhash __123123123__ __456456456__]
+ lappend rv [r hmget bighash __123123123__ __456456456__]
+ set _ $rv
+ } {{{} {}} {{} {}} {{} {}}}
+
+ test {HMGET against wrong type} {
+ r set wrongtype somevalue
+ assert_error "*wrong*" {r hmget wrongtype field1 field2}
+ }
+
+ test {HMGET - small hash} {
+ set keys {}
+ set vals {}
+ foreach {k v} [array get smallhash] {
+ lappend keys $k
+ lappend vals $v
+ }
+ set err {}
+ set result [r hmget smallhash {*}$keys]
+ if {$vals ne $result} {
+ set err "$vals != $result"
+ break
+ }
+ set _ $err
+ } {}
+
+ test {HMGET - big hash} {
+ set keys {}
+ set vals {}
+ foreach {k v} [array get bighash] {
+ lappend keys $k
+ lappend vals $v
+ }
+ set err {}
+ set result [r hmget bighash {*}$keys]
+ if {$vals ne $result} {
+ set err "$vals != $result"
+ break
+ }
+ set _ $err
+ } {}
+
+ test {HKEYS - small hash} {
+ lsort [r hkeys smallhash]
+ } [lsort [array names smallhash *]]
+
+ test {HKEYS - big hash} {
+ lsort [r hkeys bighash]
+ } [lsort [array names bighash *]]
+
+ test {HVALS - small hash} {
+ set vals {}
+ foreach {k v} [array get smallhash] {
+ lappend vals $v
+ }
+ set _ [lsort $vals]
+ } [lsort [r hvals smallhash]]
+
+ test {HVALS - big hash} {
+ set vals {}
+ foreach {k v} [array get bighash] {
+ lappend vals $v
+ }
+ set _ [lsort $vals]
+ } [lsort [r hvals bighash]]
+
+ test {HGETALL - small hash} {
+ lsort [r hgetall smallhash]
+ } [lsort [array get smallhash]]
+
+ test {HGETALL - big hash} {
+ lsort [r hgetall bighash]
+ } [lsort [array get bighash]]
+
+ test {HDEL and return value} {
+ set rv {}
+ lappend rv [r hdel smallhash nokey]
+ lappend rv [r hdel bighash nokey]
+ set k [lindex [array names smallhash *] 0]
+ lappend rv [r hdel smallhash $k]
+ lappend rv [r hdel smallhash $k]
+ lappend rv [r hget smallhash $k]
+ unset smallhash($k)
+ set k [lindex [array names bighash *] 0]
+ lappend rv [r hdel bighash $k]
+ lappend rv [r hdel bighash $k]
+ lappend rv [r hget bighash $k]
+ unset bighash($k)
+ set _ $rv
+ } {0 0 1 0 {} 1 0 {}}
+
+ test {HDEL - more than a single value} {
+ set rv {}
+ r del myhash
+ r hmset myhash a 1 b 2 c 3
+ assert_equal 0 [r hdel myhash x y]
+ assert_equal 2 [r hdel myhash a c f]
+ r hgetall myhash
+ } {b 2}
+
+ test {HDEL - hash becomes empty before deleting all specified fields} {
+ r del myhash
+ r hmset myhash a 1 b 2 c 3
+ assert_equal 3 [r hdel myhash a b c d e]
+ assert_equal 0 [r exists myhash]
+ }
+
+ test {HEXISTS} {
+ set rv {}
+ set k [lindex [array names smallhash *] 0]
+ lappend rv [r hexists smallhash $k]
+ lappend rv [r hexists smallhash nokey]
+ set k [lindex [array names bighash *] 0]
+ lappend rv [r hexists bighash $k]
+ lappend rv [r hexists bighash nokey]
+ } {1 0 1 0}
+
+ test {Is a ziplist encoded Hash promoted on big payload?} {
+ r hset smallhash foo [string repeat a 1024]
+ r debug object smallhash
+ } {*hashtable*}
+
+ test {HINCRBY against non existing database key} {
+ r del htest
+ list [r hincrby htest foo 2]
+ } {2}
+
+ test {HINCRBY against non existing hash key} {
+ set rv {}
+ r hdel smallhash tmp
+ r hdel bighash tmp
+ lappend rv [r hincrby smallhash tmp 2]
+ lappend rv [r hget smallhash tmp]
+ lappend rv [r hincrby bighash tmp 2]
+ lappend rv [r hget bighash tmp]
+ } {2 2 2 2}
+
+ test {HINCRBY against hash key created by hincrby itself} {
+ set rv {}
+ lappend rv [r hincrby smallhash tmp 3]
+ lappend rv [r hget smallhash tmp]
+ lappend rv [r hincrby bighash tmp 3]
+ lappend rv [r hget bighash tmp]
+ } {5 5 5 5}
+
+ test {HINCRBY against hash key originally set with HSET} {
+ r hset smallhash tmp 100
+ r hset bighash tmp 100
+ list [r hincrby smallhash tmp 2] [r hincrby bighash tmp 2]
+ } {102 102}
+
+ test {HINCRBY over 32bit value} {
+ r hset smallhash tmp 17179869184
+ r hset bighash tmp 17179869184
+ list [r hincrby smallhash tmp 1] [r hincrby bighash tmp 1]
+ } {17179869185 17179869185}
+
+ test {HINCRBY over 32bit value with over 32bit increment} {
+ r hset smallhash tmp 17179869184
+ r hset bighash tmp 17179869184
+ list [r hincrby smallhash tmp 17179869184] [r hincrby bighash tmp 17179869184]
+ } {34359738368 34359738368}
+
+ test {HINCRBY fails against hash value with spaces (left)} {
+ r hset smallhash str " 11"
+ r hset bighash str " 11"
+ catch {r hincrby smallhash str 1} smallerr
+ catch {r hincrby smallhash str 1} bigerr
+ set rv {}
+ lappend rv [string match "ERR*not an integer*" $smallerr]
+ lappend rv [string match "ERR*not an integer*" $bigerr]
+ } {1 1}
+
+ test {HINCRBY fails against hash value with spaces (right)} {
+ r hset smallhash str "11 "
+ r hset bighash str "11 "
+ catch {r hincrby smallhash str 1} smallerr
+ catch {r hincrby smallhash str 1} bigerr
+ set rv {}
+ lappend rv [string match "ERR*not an integer*" $smallerr]
+ lappend rv [string match "ERR*not an integer*" $bigerr]
+ } {1 1}
+
+ test {HINCRBY can detect overflows} {
+ set e {}
+ r hset hash n -9223372036854775484
+ assert {[r hincrby hash n -1] == -9223372036854775485}
+ catch {r hincrby hash n -10000} e
+ set e
+ } {*overflow*}
+
+ test {HINCRBYFLOAT against non existing database key} {
+ r del htest
+ list [r hincrbyfloat htest foo 2.5]
+ } {2.5}
+
+ test {HINCRBYFLOAT against non existing hash key} {
+ set rv {}
+ r hdel smallhash tmp
+ r hdel bighash tmp
+ lappend rv [roundFloat [r hincrbyfloat smallhash tmp 2.5]]
+ lappend rv [roundFloat [r hget smallhash tmp]]
+ lappend rv [roundFloat [r hincrbyfloat bighash tmp 2.5]]
+ lappend rv [roundFloat [r hget bighash tmp]]
+ } {2.5 2.5 2.5 2.5}
+
+ test {HINCRBYFLOAT against hash key created by hincrby itself} {
+ set rv {}
+ lappend rv [roundFloat [r hincrbyfloat smallhash tmp 3.5]]
+ lappend rv [roundFloat [r hget smallhash tmp]]
+ lappend rv [roundFloat [r hincrbyfloat bighash tmp 3.5]]
+ lappend rv [roundFloat [r hget bighash tmp]]
+ } {6 6 6 6}
+
+ test {HINCRBYFLOAT against hash key originally set with HSET} {
+ r hset smallhash tmp 100
+ r hset bighash tmp 100
+ list [roundFloat [r hincrbyfloat smallhash tmp 2.5]] \
+ [roundFloat [r hincrbyfloat bighash tmp 2.5]]
+ } {102.5 102.5}
+
+ test {HINCRBYFLOAT over 32bit value} {
+ r hset smallhash tmp 17179869184
+ r hset bighash tmp 17179869184
+ list [r hincrbyfloat smallhash tmp 1] \
+ [r hincrbyfloat bighash tmp 1]
+ } {17179869185 17179869185}
+
+ test {HINCRBYFLOAT over 32bit value with over 32bit increment} {
+ r hset smallhash tmp 17179869184
+ r hset bighash tmp 17179869184
+ list [r hincrbyfloat smallhash tmp 17179869184] \
+ [r hincrbyfloat bighash tmp 17179869184]
+ } {34359738368 34359738368}
+
+ test {HINCRBYFLOAT fails against hash value with spaces (left)} {
+ r hset smallhash str " 11"
+ r hset bighash str " 11"
+ catch {r hincrbyfloat smallhash str 1} smallerr
+ catch {r hincrbyfloat smallhash str 1} bigerr
+ set rv {}
+ lappend rv [string match "ERR*not*float*" $smallerr]
+ lappend rv [string match "ERR*not*float*" $bigerr]
+ } {1 1}
+
+ test {HINCRBYFLOAT fails against hash value with spaces (right)} {
+ r hset smallhash str "11 "
+ r hset bighash str "11 "
+ catch {r hincrbyfloat smallhash str 1} smallerr
+ catch {r hincrbyfloat smallhash str 1} bigerr
+ set rv {}
+ lappend rv [string match "ERR*not*float*" $smallerr]
+ lappend rv [string match "ERR*not*float*" $bigerr]
+ } {1 1}
+
+ test {HSTRLEN against the small hash} {
+ set err {}
+ foreach k [array names smallhash *] {
+ if {[string length $smallhash($k)] ne [r hstrlen smallhash $k]} {
+ set err "[string length $smallhash($k)] != [r hstrlen smallhash $k]"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ test {HSTRLEN against the big hash} {
+ set err {}
+ foreach k [array names bighash *] {
+ if {[string length $bighash($k)] ne [r hstrlen bighash $k]} {
+ set err "[string length $bighash($k)] != [r hstrlen bighash $k]"
+ puts "HSTRLEN and logical length mismatch:"
+ puts "key: $k"
+ puts "Logical content: $bighash($k)"
+ puts "Server content: [r hget bighash $k]"
+ }
+ }
+ set _ $err
+ } {}
+
+ test {HSTRLEN against non existing field} {
+ set rv {}
+ lappend rv [r hstrlen smallhash __123123123__]
+ lappend rv [r hstrlen bighash __123123123__]
+ set _ $rv
+ } {0 0}
+
+ test {HSTRLEN corner cases} {
+ set vals {
+ -9223372036854775808 9223372036854775807 9223372036854775808
+ {} 0 -1 x
+ }
+ foreach v $vals {
+ r hmset smallhash field $v
+ r hmset bighash field $v
+ set len1 [string length $v]
+ set len2 [r hstrlen smallhash field]
+ set len3 [r hstrlen bighash field]
+ assert {$len1 == $len2}
+ assert {$len2 == $len3}
+ }
+ }
+
+ test {Hash ziplist regression test for large keys} {
+ r hset hash kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk a
+ r hset hash kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk b
+ r hget hash kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
+ } {b}
+
+ foreach size {10 512} {
+ test "Hash fuzzing #1 - $size fields" {
+ for {set times 0} {$times < 10} {incr times} {
+ catch {unset hash}
+ array set hash {}
+ r del hash
+
+ # Create
+ for {set j 0} {$j < $size} {incr j} {
+ set field [randomValue]
+ set value [randomValue]
+ r hset hash $field $value
+ set hash($field) $value
+ }
+
+ # Verify
+ foreach {k v} [array get hash] {
+ assert_equal $v [r hget hash $k]
+ }
+ assert_equal [array size hash] [r hlen hash]
+ }
+ }
+
+ test "Hash fuzzing #2 - $size fields" {
+ for {set times 0} {$times < 10} {incr times} {
+ catch {unset hash}
+ array set hash {}
+ r del hash
+
+ # Create
+ for {set j 0} {$j < $size} {incr j} {
+ randpath {
+ set field [randomValue]
+ set value [randomValue]
+ r hset hash $field $value
+ set hash($field) $value
+ } {
+ set field [randomSignedInt 512]
+ set value [randomSignedInt 512]
+ r hset hash $field $value
+ set hash($field) $value
+ } {
+ randpath {
+ set field [randomValue]
+ } {
+ set field [randomSignedInt 512]
+ }
+ r hdel hash $field
+ unset -nocomplain hash($field)
+ }
+ }
+
+ # Verify
+ foreach {k v} [array get hash] {
+ assert_equal $v [r hget hash $k]
+ }
+ assert_equal [array size hash] [r hlen hash]
+ }
+ }
+ }
+
+ test {Stress test the hash ziplist -> hashtable encoding conversion} {
+ r config set hash-max-ziplist-entries 32
+ for {set j 0} {$j < 100} {incr j} {
+ r del myhash
+ for {set i 0} {$i < 64} {incr i} {
+ r hset myhash [randomValue] [randomValue]
+ }
+ assert {[r object encoding myhash] eq {hashtable}}
+ }
+ }
+
+ # The following test can only be executed if we don't use Valgrind, and if
+ # we are using x86_64 architecture, because:
+ #
+ # 1) Valgrind has floating point limitations, no support for 80 bits math.
+ # 2) Other archs may have the same limits.
+ #
+ # 1.23 cannot be represented correctly with 64 bit doubles, so we skip
+ # the test, since we are only testing pretty printing here and is not
+ # a bug if the program outputs things like 1.299999...
+ if {!$::valgrind && [string match *x86_64* [exec uname -a]]} {
+ test {Test HINCRBYFLOAT for correct float representation (issue #2846)} {
+ r del myhash
+ assert {[r hincrbyfloat myhash float 1.23] eq {1.23}}
+ assert {[r hincrbyfloat myhash float 0.77] eq {2}}
+ assert {[r hincrbyfloat myhash float -0.1] eq {1.9}}
+ }
+ }
+}
diff --git a/tests/unit/type/incr.tcl b/tests/unit/type/incr.tcl
new file mode 100644
index 0000000..2287aaa
--- /dev/null
+++ b/tests/unit/type/incr.tcl
@@ -0,0 +1,147 @@
+start_server {tags {"incr"}} {
+ test {INCR against non existing key} {
+ set res {}
+ append res [r incr novar]
+ append res [r get novar]
+ } {11}
+
+ test {INCR against key created by incr itself} {
+ r incr novar
+ } {2}
+
+ test {INCR against key originally set with SET} {
+ r set novar 100
+ r incr novar
+ } {101}
+
+ test {INCR over 32bit value} {
+ r set novar 17179869184
+ r incr novar
+ } {17179869185}
+
+ test {INCRBY over 32bit value with over 32bit increment} {
+ r set novar 17179869184
+ r incrby novar 17179869184
+ } {34359738368}
+
+ test {INCR fails against key with spaces (left)} {
+ r set novar " 11"
+ catch {r incr novar} err
+ format $err
+ } {ERR*}
+
+ test {INCR fails against key with spaces (right)} {
+ r set novar "11 "
+ catch {r incr novar} err
+ format $err
+ } {ERR*}
+
+ test {INCR fails against key with spaces (both)} {
+ r set novar " 11 "
+ catch {r incr novar} err
+ format $err
+ } {ERR*}
+
+ test {INCR fails against a key holding a list} {
+ r rpush mylist 1
+ catch {r incr mylist} err
+ r rpop mylist
+ format $err
+ } {WRONGTYPE*}
+
+ test {DECRBY over 32bit value with over 32bit increment, negative res} {
+ r set novar 17179869184
+ r decrby novar 17179869185
+ } {-1}
+
+ test {INCR uses shared objects in the 0-9999 range} {
+ r set foo -1
+ r incr foo
+ assert {[r object refcount foo] > 1}
+ r set foo 9998
+ r incr foo
+ assert {[r object refcount foo] > 1}
+ r incr foo
+ assert {[r object refcount foo] == 1}
+ }
+
+ test {INCR can modify objects in-place} {
+ r set foo 20000
+ r incr foo
+ assert {[r object refcount foo] == 1}
+ set old [lindex [split [r debug object foo]] 1]
+ r incr foo
+ set new [lindex [split [r debug object foo]] 1]
+ assert {[string range $old 0 2] eq "at:"}
+ assert {[string range $new 0 2] eq "at:"}
+ assert {$old eq $new}
+ }
+
+ test {INCRBYFLOAT against non existing key} {
+ r del novar
+ list [roundFloat [r incrbyfloat novar 1]] \
+ [roundFloat [r get novar]] \
+ [roundFloat [r incrbyfloat novar 0.25]] \
+ [roundFloat [r get novar]]
+ } {1 1 1.25 1.25}
+
+ test {INCRBYFLOAT against key originally set with SET} {
+ r set novar 1.5
+ roundFloat [r incrbyfloat novar 1.5]
+ } {3}
+
+ test {INCRBYFLOAT over 32bit value} {
+ r set novar 17179869184
+ r incrbyfloat novar 1.5
+ } {17179869185.5}
+
+ test {INCRBYFLOAT over 32bit value with over 32bit increment} {
+ r set novar 17179869184
+ r incrbyfloat novar 17179869184
+ } {34359738368}
+
+ test {INCRBYFLOAT fails against key with spaces (left)} {
+ set err {}
+ r set novar " 11"
+ catch {r incrbyfloat novar 1.0} err
+ format $err
+ } {ERR*valid*}
+
+ test {INCRBYFLOAT fails against key with spaces (right)} {
+ set err {}
+ r set novar "11 "
+ catch {r incrbyfloat novar 1.0} err
+ format $err
+ } {ERR*valid*}
+
+ test {INCRBYFLOAT fails against key with spaces (both)} {
+ set err {}
+ r set novar " 11 "
+ catch {r incrbyfloat novar 1.0} err
+ format $err
+ } {ERR*valid*}
+
+ test {INCRBYFLOAT fails against a key holding a list} {
+ r del mylist
+ set err {}
+ r rpush mylist 1
+ catch {r incrbyfloat mylist 1.0} err
+ r del mylist
+ format $err
+ } {WRONGTYPE*}
+
+ test {INCRBYFLOAT does not allow NaN or Infinity} {
+ r set foo 0
+ set err {}
+ catch {r incrbyfloat foo +inf} err
+ set err
+ # p.s. no way I can force NaN to test it from the API because
+ # there is no way to increment / decrement by infinity nor to
+ # perform divisions.
+ } {ERR*would produce*}
+
+ test {INCRBYFLOAT decrement} {
+ r set foo 1
+ roundFloat [r incrbyfloat foo -1.1]
+ } {-0.1}
+}
diff --git a/tests/unit/type/list-2.tcl b/tests/unit/type/list-2.tcl
new file mode 100644
index 0000000..4c7d6d9
--- /dev/null
+++ b/tests/unit/type/list-2.tcl
@@ -0,0 +1,47 @@
+start_server {
+ tags {"list"}
+ overrides {
+ "list-max-ziplist-size" 4
+ }
+} {
+ source "tests/unit/type/list-common.tcl"
+
+ foreach {type large} [array get largevalue] {
+ tags {"slow"} {
+ test "LTRIM stress testing - $type" {
+ set mylist {}
+ set startlen 32
+ r del mylist
+
+ # Start with the large value to ensure the
+ # right encoding is used.
+ r rpush mylist $large
+ lappend mylist $large
+
+ for {set i 0} {$i < $startlen} {incr i} {
+ set str [randomInt 9223372036854775807]
+ r rpush mylist $str
+ lappend mylist $str
+ }
+
+ for {set i 0} {$i < 1000} {incr i} {
+ set min [expr {int(rand()*$startlen)}]
+ set max [expr {$min+int(rand()*$startlen)}]
+ set before_len [llength $mylist]
+ set before_len_r [r llen mylist]
+ set mylist [lrange $mylist $min $max]
+ r ltrim mylist $min $max
+ assert_equal $mylist [r lrange mylist 0 -1] "failed trim"
+
+ set starting [r llen mylist]
+ for {set j [r llen mylist]} {$j < $startlen} {incr j} {
+ set str [randomInt 9223372036854775807]
+ r rpush mylist $str
+ lappend mylist $str
+ assert_equal $mylist [r lrange mylist 0 -1] "failed append match"
+ }
+ }
+ }
+ }
+ }
+}
diff --git a/tests/unit/type/list-3.tcl b/tests/unit/type/list-3.tcl
new file mode 100644
index 0000000..b5bd48c
--- /dev/null
+++ b/tests/unit/type/list-3.tcl
@@ -0,0 +1,122 @@
+start_server {
+ tags {list ziplist}
+ overrides {
+ "list-max-ziplist-size" 16
+ }
+} {
+ test {Explicit regression for a list bug} {
+ set mylist {49376042582 {BkG2o\pIC]4YYJa9cJ4GWZalG[4tin;1D2whSkCOW`mX;SFXGyS8sedcff3fQI^tgPCC@^Nu1J6o]meM@Lko]t_jRyo<xSJ1oObDYd`ppZuW6P@fS278YaOx=s6lvdFlMbP0[SbkI^Kr\HBXtuFaA^mDx:yzS4a[skiiPWhT<nNfAf=aQVfclcuwDrfe;iVuKdNvB9kbfq>tK?tH[\EvWqS]b`o2OCtjg:?nUTwdjpcUm]y:pg5q24q7LlCOwQE^}}
+ r del l
+ r rpush l [lindex $mylist 0]
+ r rpush l [lindex $mylist 1]
+ assert_equal [r lindex l 0] [lindex $mylist 0]
+ assert_equal [r lindex l 1] [lindex $mylist 1]
+ }
+
+ test {Regression for quicklist #3343 bug} {
+ r del mylist
+ r lpush mylist 401
+ r lpush mylist 392
+ r rpush mylist [string repeat x 5105]"799"
+ r lset mylist -1 [string repeat x 1014]"702"
+ r lpop mylist
+ r lset mylist -1 [string repeat x 4149]"852"
+ r linsert mylist before 401 [string repeat x 9927]"12"
+ r lrange mylist 0 -1
+ r ping ; # It's enough if the server is still alive
+ } {PONG}
+
+ test {Stress tester for #3343-alike bugs} {
+ r del key
+ for {set j 0} {$j < 10000} {incr j} {
+ set op [randomInt 6]
+ set small_signed_count [expr 5-[randomInt 10]]
+ if {[randomInt 2] == 0} {
+ set ele [randomInt 1000]
+ } else {
+ set ele [string repeat x [randomInt 10000]][randomInt 1000]
+ }
+ switch $op {
+ 0 {r lpush key $ele}
+ 1 {r rpush key $ele}
+ 2 {r lpop key}
+ 3 {r rpop key}
+ 4 {
+ catch {r lset key $small_signed_count $ele}
+ }
+ 5 {
+ set otherele [randomInt 1000]
+ if {[randomInt 2] == 0} {
+ set where before
+ } else {
+ set where after
+ }
+ r linsert key $where $otherele $ele
+ }
+ }
+ }
+ }
+
+ tags {slow} {
+ test {ziplist implementation: value encoding and backlink} {
+ if {$::accurate} {set iterations 100} else {set iterations 10}
+ for {set j 0} {$j < $iterations} {incr j} {
+ r del l
+ set l {}
+ for {set i 0} {$i < 200} {incr i} {
+ randpath {
+ set data [string repeat x [randomInt 100000]]
+ } {
+ set data [randomInt 65536]
+ } {
+ set data [randomInt 4294967296]
+ } {
+ set data [randomInt 18446744073709551616]
+ } {
+ set data -[randomInt 65536]
+ if {$data eq {-0}} {set data 0}
+ } {
+ set data -[randomInt 4294967296]
+ if {$data eq {-0}} {set data 0}
+ } {
+ set data -[randomInt 18446744073709551616]
+ if {$data eq {-0}} {set data 0}
+ }
+ lappend l $data
+ r rpush l $data
+ }
+ assert_equal [llength $l] [r llen l]
+ # Traverse backward
+ for {set i 199} {$i >= 0} {incr i -1} {
+ if {[lindex $l $i] ne [r lindex l $i]} {
+ assert_equal [lindex $l $i] [r lindex l $i]
+ }
+ }
+ }
+ }
+
+ test {ziplist implementation: encoding stress testing} {
+ for {set j 0} {$j < 200} {incr j} {
+ r del l
+ set l {}
+ set len [randomInt 400]
+ for {set i 0} {$i < $len} {incr i} {
+ set rv [randomValue]
+ randpath {
+ lappend l $rv
+ r rpush l $rv
+ } {
+ set l [concat [list $rv] $l]
+ r lpush l $rv
+ }
+ }
+ assert_equal [llength $l] [r llen l]
+ for {set i 0} {$i < $len} {incr i} {
+ if {[lindex $l $i] ne [r lindex l $i]} {
+ assert_equal [lindex $l $i] [r lindex l $i]
+ }
+ }
+ }
+ }
+ }
+}
diff --git a/tests/unit/type/list-common.tcl b/tests/unit/type/list-common.tcl
new file mode 100644
index 0000000..ab45f0b
--- /dev/null
+++ b/tests/unit/type/list-common.tcl
@@ -0,0 +1,5 @@
+# We need a value larger than list-max-ziplist-value to make sure
+# the list has the right encoding when it is swapped in again.
+array set largevalue {}
+set largevalue(ziplist) "hello"
+set largevalue(linkedlist) [string repeat "hello" 4]
diff --git a/tests/unit/type/list.tcl b/tests/unit/type/list.tcl
new file mode 100644
index 0000000..1557082
--- /dev/null
+++ b/tests/unit/type/list.tcl
@@ -0,0 +1,837 @@
+start_server {
+ tags {"list"}
+ overrides {
+ "list-max-ziplist-size" 5
+ }
+} {
+ source "tests/unit/type/list-common.tcl"
+
+ test {LPUSH, RPUSH, LLENGTH, LINDEX, LPOP - ziplist} {
+ # first lpush then rpush
+ assert_equal 1 [r lpush myziplist1 aa]
+ assert_equal 2 [r rpush myziplist1 bb]
+ assert_equal 3 [r rpush myziplist1 cc]
+ assert_equal 3 [r llen myziplist1]
+ assert_equal aa [r lindex myziplist1 0]
+ assert_equal bb [r lindex myziplist1 1]
+ assert_equal cc [r lindex myziplist1 2]
+ assert_equal {} [r lindex myziplist2 3]
+ assert_equal cc [r rpop myziplist1]
+ assert_equal aa [r lpop myziplist1]
+ assert_encoding quicklist myziplist1
+
+ # first rpush then lpush
+ assert_equal 1 [r rpush myziplist2 a]
+ assert_equal 2 [r lpush myziplist2 b]
+ assert_equal 3 [r lpush myziplist2 c]
+ assert_equal 3 [r llen myziplist2]
+ assert_equal c [r lindex myziplist2 0]
+ assert_equal b [r lindex myziplist2 1]
+ assert_equal a [r lindex myziplist2 2]
+ assert_equal {} [r lindex myziplist2 3]
+ assert_equal a [r rpop myziplist2]
+ assert_equal c [r lpop myziplist2]
+ assert_encoding quicklist myziplist2
+ }
+
+ test {LPUSH, RPUSH, LLENGTH, LINDEX, LPOP - regular list} {
+ # first lpush then rpush
+ assert_equal 1 [r lpush mylist1 $largevalue(linkedlist)]
+ assert_encoding quicklist mylist1
+ assert_equal 2 [r rpush mylist1 b]
+ assert_equal 3 [r rpush mylist1 c]
+ assert_equal 3 [r llen mylist1]
+ assert_equal $largevalue(linkedlist) [r lindex mylist1 0]
+ assert_equal b [r lindex mylist1 1]
+ assert_equal c [r lindex mylist1 2]
+ assert_equal {} [r lindex mylist1 3]
+ assert_equal c [r rpop mylist1]
+ assert_equal $largevalue(linkedlist) [r lpop mylist1]
+
+ # first rpush then lpush
+ assert_equal 1 [r rpush mylist2 $largevalue(linkedlist)]
+ assert_encoding quicklist mylist2
+ assert_equal 2 [r lpush mylist2 b]
+ assert_equal 3 [r lpush mylist2 c]
+ assert_equal 3 [r llen mylist2]
+ assert_equal c [r lindex mylist2 0]
+ assert_equal b [r lindex mylist2 1]
+ assert_equal $largevalue(linkedlist) [r lindex mylist2 2]
+ assert_equal {} [r lindex mylist2 3]
+ assert_equal $largevalue(linkedlist) [r rpop mylist2]
+ assert_equal c [r lpop mylist2]
+ }
+
+ test {R/LPOP against empty list} {
+ r lpop non-existing-list
+ } {}
+
+ test {Variadic RPUSH/LPUSH} {
+ r del mylist
+ assert_equal 4 [r lpush mylist a b c d]
+ assert_equal 8 [r rpush mylist 0 1 2 3]
+ assert_equal {d c b a 0 1 2 3} [r lrange mylist 0 -1]
+ }
+
+ test {DEL a list} {
+ assert_equal 1 [r del mylist2]
+ assert_equal 0 [r exists mylist2]
+ assert_equal 0 [r llen mylist2]
+ }
+
+ proc create_list {key entries} {
+ r del $key
+ foreach entry $entries { r rpush $key $entry }
+ assert_encoding quicklist $key
+ }
+
+ foreach {type large} [array get largevalue] {
+ test "BLPOP, BRPOP: single existing list - $type" {
+ set rd [redis_deferring_client]
+ create_list blist "a b $large 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_list blist1 "a $large c"
+ create_list blist2 "d $large 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_list blist2 "d $large 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]
+ }
+
+ test "BRPOPLPUSH - $type" {
+ r del target
+
+ set rd [redis_deferring_client]
+ create_list blist "a b $large c d"
+
+ $rd brpoplpush blist target 1
+ assert_equal d [$rd read]
+
+ assert_equal d [r rpop target]
+ assert_equal "a b $large c" [r lrange blist 0 -1]
+ }
+ }
+
+ test "BLPOP, LPUSH + DEL should not awake blocked client" {
+ set rd [redis_deferring_client]
+ r del list
+
+ $rd blpop list 0
+ r multi
+ r lpush list a
+ r del list
+ r exec
+ r del list
+ r lpush list b
+ $rd read
+ } {list b}
+
+ test "BLPOP, LPUSH + DEL + SET should not awake blocked client" {
+ set rd [redis_deferring_client]
+ r del list
+
+ $rd blpop list 0
+ r multi
+ r lpush list a
+ r del list
+ r set list foo
+ r exec
+ r del list
+ r lpush list b
+ $rd read
+ } {list b}
+
+ test "BLPOP with same key multiple times should work (issue #801)" {
+ set rd [redis_deferring_client]
+ r del list1 list2
+
+ # Data arriving after the BLPOP.
+ $rd blpop list1 list2 list2 list1 0
+ r lpush list1 a
+ assert_equal [$rd read] {list1 a}
+ $rd blpop list1 list2 list2 list1 0
+ r lpush list2 b
+ assert_equal [$rd read] {list2 b}
+
+ # Data already there.
+ r lpush list1 a
+ r lpush list2 b
+ $rd blpop list1 list2 list2 list1 0
+ assert_equal [$rd read] {list1 a}
+ $rd blpop list1 list2 list2 list1 0
+ assert_equal [$rd read] {list2 b}
+ }
+
+ test "MULTI/EXEC is isolated from the point of view of BLPOP" {
+ set rd [redis_deferring_client]
+ r del list
+ $rd blpop list 0
+ r multi
+ r lpush list a
+ r lpush list b
+ r lpush list c
+ r exec
+ $rd read
+ } {list c}
+
+ test "BLPOP with variadic LPUSH" {
+ set rd [redis_deferring_client]
+ r del blist target
+ if {$::valgrind} {after 100}
+ $rd blpop blist 0
+ if {$::valgrind} {after 100}
+ assert_equal 2 [r lpush blist foo bar]
+ if {$::valgrind} {after 100}
+ assert_equal {blist bar} [$rd read]
+ assert_equal foo [lindex [r lrange blist 0 -1] 0]
+ }
+
+ test "BRPOPLPUSH with zero timeout should block indefinitely" {
+ set rd [redis_deferring_client]
+ r del blist target
+ $rd brpoplpush blist target 0
+ after 1000
+ r rpush blist foo
+ assert_equal foo [$rd read]
+ assert_equal {foo} [r lrange target 0 -1]
+ }
+
+ test "BRPOPLPUSH with a client BLPOPing the target list" {
+ set rd [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+ r del blist target
+ $rd2 blpop target 0
+ $rd brpoplpush blist target 0
+ after 1000
+ r rpush blist foo
+ assert_equal foo [$rd read]
+ assert_equal {target foo} [$rd2 read]
+ assert_equal 0 [r exists target]
+ }
+
+ test "BRPOPLPUSH with wrong source type" {
+ set rd [redis_deferring_client]
+ r del blist target
+ r set blist nolist
+ $rd brpoplpush blist target 1
+ assert_error "WRONGTYPE*" {$rd read}
+ }
+
+ test "BRPOPLPUSH with wrong destination type" {
+ set rd [redis_deferring_client]
+ r del blist target
+ r set target nolist
+ r lpush blist foo
+ $rd brpoplpush blist target 1
+ assert_error "WRONGTYPE*" {$rd read}
+
+ set rd [redis_deferring_client]
+ r del blist target
+ r set target nolist
+ $rd brpoplpush blist target 0
+ after 1000
+ r rpush blist foo
+ assert_error "WRONGTYPE*" {$rd read}
+ assert_equal {foo} [r lrange blist 0 -1]
+ }
+
+ test "BRPOPLPUSH maintains order of elements after failure" {
+ set rd [redis_deferring_client]
+ r del blist target
+ r set target nolist
+ $rd brpoplpush blist target 0
+ r rpush blist a b c
+ assert_error "WRONGTYPE*" {$rd read}
+ r lrange blist 0 -1
+ } {a b c}
+
+ test "BRPOPLPUSH with multiple blocked clients" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+ r del blist target1 target2
+ r set target1 nolist
+ $rd1 brpoplpush blist target1 0
+ $rd2 brpoplpush blist target2 0
+ r lpush blist foo
+
+ assert_error "WRONGTYPE*" {$rd1 read}
+ assert_equal {foo} [$rd2 read]
+ assert_equal {foo} [r lrange target2 0 -1]
+ }
+
+ test "Linked BRPOPLPUSH" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+
+ r del list1 list2 list3
+
+ $rd1 brpoplpush list1 list2 0
+ $rd2 brpoplpush list2 list3 0
+
+ r rpush list1 foo
+
+ assert_equal {} [r lrange list1 0 -1]
+ assert_equal {} [r lrange list2 0 -1]
+ assert_equal {foo} [r lrange list3 0 -1]
+ }
+
+ test "Circular BRPOPLPUSH" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+
+ r del list1 list2
+
+ $rd1 brpoplpush list1 list2 0
+ $rd2 brpoplpush list2 list1 0
+
+ r rpush list1 foo
+
+ assert_equal {foo} [r lrange list1 0 -1]
+ assert_equal {} [r lrange list2 0 -1]
+ }
+
+ test "Self-referential BRPOPLPUSH" {
+ set rd [redis_deferring_client]
+
+ r del blist
+
+ $rd brpoplpush blist blist 0
+
+ r rpush blist foo
+
+ assert_equal {foo} [r lrange blist 0 -1]
+ }
+
+ test "BRPOPLPUSH inside a transaction" {
+ r del xlist target
+ r lpush xlist foo
+ r lpush xlist bar
+
+ r multi
+ r brpoplpush xlist target 0
+ r brpoplpush xlist target 0
+ r brpoplpush xlist target 0
+ r lrange xlist 0 -1
+ r lrange target 0 -1
+ r exec
+ } {foo bar {} {} {bar foo}}
+
+ test "PUSH resulting from BRPOPLPUSH affect WATCH" {
+ set blocked_client [redis_deferring_client]
+ set watching_client [redis_deferring_client]
+ r del srclist dstlist somekey
+ r set somekey somevalue
+ $blocked_client brpoplpush srclist dstlist 0
+ $watching_client watch dstlist
+ $watching_client read
+ $watching_client multi
+ $watching_client read
+ $watching_client get somekey
+ $watching_client read
+ r lpush srclist element
+ $watching_client exec
+ $watching_client read
+ } {}
+
+ test "BRPOPLPUSH does not affect WATCH while still blocked" {
+ set blocked_client [redis_deferring_client]
+ set watching_client [redis_deferring_client]
+ r del srclist dstlist somekey
+ r set somekey somevalue
+ $blocked_client brpoplpush srclist dstlist 0
+ $watching_client watch dstlist
+ $watching_client read
+ $watching_client multi
+ $watching_client read
+ $watching_client get somekey
+ $watching_client read
+ $watching_client exec
+ # Blocked BLPOPLPUSH may create problems, unblock it.
+ r lpush srclist element
+ $watching_client read
+ } {somevalue}
+
+ test {BRPOPLPUSH timeout} {
+ set rd [redis_deferring_client]
+
+ $rd brpoplpush foo_list bar_list 1
+ after 2000
+ $rd read
+ } {}
+
+ test "BLPOP when new key is moved into place" {
+ set rd [redis_deferring_client]
+
+ $rd blpop foo 5
+ r lpush bob abc def hij
+ r rename bob foo
+ $rd read
+ } {foo hij}
+
+ test "BLPOP when result key is created by SORT..STORE" {
+ set rd [redis_deferring_client]
+
+ # zero out list from previous test without explicit delete
+ r lpop foo
+ r lpop foo
+ r lpop foo
+
+ $rd blpop foo 5
+ r lpush notfoo hello hola aguacate konichiwa zanzibar
+ r sort notfoo ALPHA store foo
+ $rd read
+ } {foo aguacate}
+
+ 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 "WRONGTYPE*" {$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 {BLPOP inside a transaction} {
+ r del xlist
+ r lpush xlist foo
+ r lpush xlist bar
+ r multi
+ r blpop xlist 0
+ r blpop xlist 0
+ r blpop xlist 0
+ r exec
+ } {{xlist bar} {xlist foo} {}}
+
+ test {LPUSHX, RPUSHX - generic} {
+ r del xlist
+ assert_equal 0 [r lpushx xlist a]
+ assert_equal 0 [r llen xlist]
+ assert_equal 0 [r rpushx xlist a]
+ assert_equal 0 [r llen xlist]
+ }
+
+ foreach {type large} [array get largevalue] {
+ test "LPUSHX, RPUSHX - $type" {
+ create_list xlist "$large c"
+ assert_equal 3 [r rpushx xlist d]
+ assert_equal 4 [r lpushx xlist a]
+ assert_equal 6 [r rpushx xlist 42 x]
+ assert_equal 9 [r lpushx xlist y3 y2 y1]
+ assert_equal "y1 y2 y3 a $large c d 42 x" [r lrange xlist 0 -1]
+ }
+
+ test "LINSERT - $type" {
+ create_list xlist "a $large c d"
+ assert_equal 5 [r linsert xlist before c zz] "before c"
+ assert_equal "a $large zz c d" [r lrange xlist 0 10] "lrangeA"
+ assert_equal 6 [r linsert xlist after c yy] "after c"
+ assert_equal "a $large zz c yy d" [r lrange xlist 0 10] "lrangeB"
+ assert_equal 7 [r linsert xlist after d dd] "after d"
+ assert_equal -1 [r linsert xlist after bad ddd] "after bad"
+ assert_equal "a $large zz c yy d dd" [r lrange xlist 0 10] "lrangeC"
+ assert_equal 8 [r linsert xlist before a aa] "before a"
+ assert_equal -1 [r linsert xlist before bad aaa] "before bad"
+ assert_equal "aa a $large zz c yy d dd" [r lrange xlist 0 10] "lrangeD"
+
+ # check inserting integer encoded value
+ assert_equal 9 [r linsert xlist before aa 42] "before aa"
+ assert_equal 42 [r lrange xlist 0 0] "lrangeE"
+ }
+ }
+
+ test {LINSERT raise error on bad syntax} {
+ catch {[r linsert xlist aft3r aa 42]} e
+ set e
+ } {*ERR*syntax*error*}
+
+ foreach {type num} {quicklist 250 quicklist 500} {
+ proc check_numbered_list_consistency {key} {
+ set len [r llen $key]
+ for {set i 0} {$i < $len} {incr i} {
+ assert_equal $i [r lindex $key $i]
+ assert_equal [expr $len-1-$i] [r lindex $key [expr (-$i)-1]]
+ }
+ }
+
+ proc check_random_access_consistency {key} {
+ set len [r llen $key]
+ for {set i 0} {$i < $len} {incr i} {
+ set rint [expr int(rand()*$len)]
+ assert_equal $rint [r lindex $key $rint]
+ assert_equal [expr $len-1-$rint] [r lindex $key [expr (-$rint)-1]]
+ }
+ }
+
+ test "LINDEX consistency test - $type" {
+ r del mylist
+ for {set i 0} {$i < $num} {incr i} {
+ r rpush mylist $i
+ }
+ assert_encoding $type mylist
+ check_numbered_list_consistency mylist
+ }
+
+ test "LINDEX random access - $type" {
+ assert_encoding $type mylist
+ check_random_access_consistency mylist
+ }
+
+ test "Check if list is still ok after a DEBUG RELOAD - $type" {
+ r debug reload
+ assert_encoding $type mylist
+ check_numbered_list_consistency mylist
+ check_random_access_consistency mylist
+ }
+ }
+
+ test {LLEN against non-list value error} {
+ r del mylist
+ r set mylist foobar
+ assert_error WRONGTYPE* {r llen mylist}
+ }
+
+ test {LLEN against non existing key} {
+ assert_equal 0 [r llen not-a-key]
+ }
+
+ test {LINDEX against non-list value error} {
+ assert_error WRONGTYPE* {r lindex mylist 0}
+ }
+
+ test {LINDEX against non existing key} {
+ assert_equal "" [r lindex not-a-key 10]
+ }
+
+ test {LPUSH against non-list value error} {
+ assert_error WRONGTYPE* {r lpush mylist 0}
+ }
+
+ test {RPUSH against non-list value error} {
+ assert_error WRONGTYPE* {r rpush mylist 0}
+ }
+
+ foreach {type large} [array get largevalue] {
+ test "RPOPLPUSH base case - $type" {
+ r del mylist1 mylist2
+ create_list mylist1 "a $large c d"
+ assert_equal d [r rpoplpush mylist1 mylist2]
+ assert_equal c [r rpoplpush mylist1 mylist2]
+ assert_equal "a $large" [r lrange mylist1 0 -1]
+ assert_equal "c d" [r lrange mylist2 0 -1]
+ assert_encoding quicklist mylist2
+ }
+
+ test "RPOPLPUSH with the same list as src and dst - $type" {
+ create_list mylist "a $large c"
+ assert_equal "a $large c" [r lrange mylist 0 -1]
+ assert_equal c [r rpoplpush mylist mylist]
+ assert_equal "c a $large" [r lrange mylist 0 -1]
+ }
+
+ foreach {othertype otherlarge} [array get largevalue] {
+ test "RPOPLPUSH with $type source and existing target $othertype" {
+ create_list srclist "a b c $large"
+ create_list dstlist "$otherlarge"
+ assert_equal $large [r rpoplpush srclist dstlist]
+ assert_equal c [r rpoplpush srclist dstlist]
+ assert_equal "a b" [r lrange srclist 0 -1]
+ assert_equal "c $large $otherlarge" [r lrange dstlist 0 -1]
+
+ # When we rpoplpush'ed a large value, dstlist should be
+ # converted to the same encoding as srclist.
+ if {$type eq "linkedlist"} {
+ assert_encoding quicklist dstlist
+ }
+ }
+ }
+ }
+
+ test {RPOPLPUSH against non existing key} {
+ r del srclist dstlist
+ assert_equal {} [r rpoplpush srclist dstlist]
+ assert_equal 0 [r exists srclist]
+ assert_equal 0 [r exists dstlist]
+ }
+
+ test {RPOPLPUSH against non list src key} {
+ r del srclist dstlist
+ r set srclist x
+ assert_error WRONGTYPE* {r rpoplpush srclist dstlist}
+ assert_type string srclist
+ assert_equal 0 [r exists newlist]
+ }
+
+ test {RPOPLPUSH against non list dst key} {
+ create_list srclist {a b c d}
+ r set dstlist x
+ assert_error WRONGTYPE* {r rpoplpush srclist dstlist}
+ assert_type string dstlist
+ assert_equal {a b c d} [r lrange srclist 0 -1]
+ }
+
+ test {RPOPLPUSH against non existing src key} {
+ r del srclist dstlist
+ assert_equal {} [r rpoplpush srclist dstlist]
+ } {}
+
+ foreach {type large} [array get largevalue] {
+ test "Basic LPOP/RPOP - $type" {
+ create_list mylist "$large 1 2"
+ assert_equal $large [r lpop mylist]
+ assert_equal 2 [r rpop mylist]
+ assert_equal 1 [r lpop mylist]
+ assert_equal 0 [r llen mylist]
+
+ # pop on empty list
+ assert_equal {} [r lpop mylist]
+ assert_equal {} [r rpop mylist]
+ }
+ }
+
+ test {LPOP/RPOP against non list value} {
+ r set notalist foo
+ assert_error WRONGTYPE* {r lpop notalist}
+ assert_error WRONGTYPE* {r rpop notalist}
+ }
+
+ foreach {type num} {quicklist 250 quicklist 500} {
+ test "Mass RPOP/LPOP - $type" {
+ r del mylist
+ set sum1 0
+ for {set i 0} {$i < $num} {incr i} {
+ r lpush mylist $i
+ incr sum1 $i
+ }
+ assert_encoding $type mylist
+ set sum2 0
+ for {set i 0} {$i < [expr $num/2]} {incr i} {
+ incr sum2 [r lpop mylist]
+ incr sum2 [r rpop mylist]
+ }
+ assert_equal $sum1 $sum2
+ }
+ }
+
+ foreach {type large} [array get largevalue] {
+ test "LRANGE basics - $type" {
+ create_list mylist "$large 1 2 3 4 5 6 7 8 9"
+ assert_equal {1 2 3 4 5 6 7 8} [r lrange mylist 1 -2]
+ assert_equal {7 8 9} [r lrange mylist -3 -1]
+ assert_equal {4} [r lrange mylist 4 4]
+ }
+
+ test "LRANGE inverted indexes - $type" {
+ create_list mylist "$large 1 2 3 4 5 6 7 8 9"
+ assert_equal {} [r lrange mylist 6 2]
+ }
+
+ test "LRANGE out of range indexes including the full list - $type" {
+ create_list mylist "$large 1 2 3"
+ assert_equal "$large 1 2 3" [r lrange mylist -1000 1000]
+ }
+
+ test "LRANGE out of range negative end index - $type" {
+ create_list mylist "$large 1 2 3"
+ assert_equal $large [r lrange mylist 0 -4]
+ assert_equal {} [r lrange mylist 0 -5]
+ }
+ }
+
+ test {LRANGE against non existing key} {
+ assert_equal {} [r lrange nosuchkey 0 1]
+ }
+
+ foreach {type large} [array get largevalue] {
+ proc trim_list {type min max} {
+ upvar 1 large large
+ r del mylist
+ create_list mylist "1 2 3 4 $large"
+ r ltrim mylist $min $max
+ r lrange mylist 0 -1
+ }
+
+ test "LTRIM basics - $type" {
+ assert_equal "1" [trim_list $type 0 0]
+ assert_equal "1 2" [trim_list $type 0 1]
+ assert_equal "1 2 3" [trim_list $type 0 2]
+ assert_equal "2 3" [trim_list $type 1 2]
+ assert_equal "2 3 4 $large" [trim_list $type 1 -1]
+ assert_equal "2 3 4" [trim_list $type 1 -2]
+ assert_equal "4 $large" [trim_list $type -2 -1]
+ assert_equal "$large" [trim_list $type -1 -1]
+ assert_equal "1 2 3 4 $large" [trim_list $type -5 -1]
+ assert_equal "1 2 3 4 $large" [trim_list $type -10 10]
+ assert_equal "1 2 3 4 $large" [trim_list $type 0 5]
+ assert_equal "1 2 3 4 $large" [trim_list $type 0 10]
+ }
+
+ test "LTRIM out of range negative end index - $type" {
+ assert_equal {1} [trim_list $type 0 -5]
+ assert_equal {} [trim_list $type 0 -6]
+ }
+
+ }
+
+ foreach {type large} [array get largevalue] {
+ test "LSET - $type" {
+ create_list mylist "99 98 $large 96 95"
+ r lset mylist 1 foo
+ r lset mylist -1 bar
+ assert_equal "99 foo $large 96 bar" [r lrange mylist 0 -1]
+ }
+
+ test "LSET out of range index - $type" {
+ assert_error ERR*range* {r lset mylist 10 foo}
+ }
+ }
+
+ test {LSET against non existing key} {
+ assert_error ERR*key* {r lset nosuchkey 10 foo}
+ }
+
+ test {LSET against non list value} {
+ r set nolist foobar
+ assert_error WRONGTYPE* {r lset nolist 0 foo}
+ }
+
+ foreach {type e} [array get largevalue] {
+ test "LREM remove all the occurrences - $type" {
+ create_list mylist "$e foo bar foobar foobared zap bar test foo"
+ assert_equal 2 [r lrem mylist 0 bar]
+ assert_equal "$e foo foobar foobared zap test foo" [r lrange mylist 0 -1]
+ }
+
+ test "LREM remove the first occurrence - $type" {
+ assert_equal 1 [r lrem mylist 1 foo]
+ assert_equal "$e foobar foobared zap test foo" [r lrange mylist 0 -1]
+ }
+
+ test "LREM remove non existing element - $type" {
+ assert_equal 0 [r lrem mylist 1 nosuchelement]
+ assert_equal "$e foobar foobared zap test foo" [r lrange mylist 0 -1]
+ }
+
+ test "LREM starting from tail with negative count - $type" {
+ create_list mylist "$e foo bar foobar foobared zap bar test foo foo"
+ assert_equal 1 [r lrem mylist -1 bar]
+ assert_equal "$e foo bar foobar foobared zap test foo foo" [r lrange mylist 0 -1]
+ }
+
+ test "LREM starting from tail with negative count (2) - $type" {
+ assert_equal 2 [r lrem mylist -2 foo]
+ assert_equal "$e foo bar foobar foobared zap test" [r lrange mylist 0 -1]
+ }
+
+ test "LREM deleting objects that may be int encoded - $type" {
+ create_list myotherlist "$e 1 2 3"
+ assert_equal 1 [r lrem myotherlist 1 2]
+ assert_equal 3 [r llen myotherlist]
+ }
+ }
+
+ test "Regression for bug 593 - chaining BRPOPLPUSH with other blocking cmds" {
+ set rd1 [redis_deferring_client]
+ set rd2 [redis_deferring_client]
+
+ $rd1 brpoplpush a b 0
+ $rd1 brpoplpush a b 0
+ $rd2 brpoplpush b c 0
+ after 1000
+ r lpush a data
+ $rd1 close
+ $rd2 close
+ r ping
+ } {PONG}
+}
diff --git a/tests/unit/type/set.tcl b/tests/unit/type/set.tcl
new file mode 100644
index 0000000..7b467f1
--- /dev/null
+++ b/tests/unit/type/set.tcl
@@ -0,0 +1,601 @@
+start_server {
+ tags {"set"}
+ overrides {
+ "set-max-intset-entries" 512
+ }
+} {
+ proc create_set {key entries} {
+ r del $key
+ foreach entry $entries { r sadd $key $entry }
+ }
+
+ test {SADD, SCARD, SISMEMBER, SMEMBERS basics - regular set} {
+ create_set myset {foo}
+ assert_encoding hashtable myset
+ assert_equal 1 [r sadd myset bar]
+ assert_equal 0 [r sadd myset bar]
+ assert_equal 2 [r scard myset]
+ assert_equal 1 [r sismember myset foo]
+ assert_equal 1 [r sismember myset bar]
+ assert_equal 0 [r sismember myset bla]
+ assert_equal {bar foo} [lsort [r smembers myset]]
+ }
+
+ test {SADD, SCARD, SISMEMBER, SMEMBERS basics - intset} {
+ create_set myset {17}
+ assert_encoding intset myset
+ assert_equal 1 [r sadd myset 16]
+ assert_equal 0 [r sadd myset 16]
+ assert_equal 2 [r scard myset]
+ assert_equal 1 [r sismember myset 16]
+ assert_equal 1 [r sismember myset 17]
+ assert_equal 0 [r sismember myset 18]
+ assert_equal {16 17} [lsort [r smembers myset]]
+ }
+
+ test {SADD against non set} {
+ r lpush mylist foo
+ assert_error WRONGTYPE* {r sadd mylist bar}
+ }
+
+ test "SADD a non-integer against an intset" {
+ create_set myset {1 2 3}
+ assert_encoding intset myset
+ assert_equal 1 [r sadd myset a]
+ assert_encoding hashtable myset
+ }
+
+ test "SADD an integer larger than 64 bits" {
+ create_set myset {213244124402402314402033402}
+ assert_encoding hashtable myset
+ assert_equal 1 [r sismember myset 213244124402402314402033402]
+ }
+
+ test "SADD overflows the maximum allowed integers in an intset" {
+ r del myset
+ for {set i 0} {$i < 512} {incr i} { r sadd myset $i }
+ assert_encoding intset myset
+ assert_equal 1 [r sadd myset 512]
+ assert_encoding hashtable myset
+ }
+
+ test {Variadic SADD} {
+ r del myset
+ assert_equal 3 [r sadd myset a b c]
+ assert_equal 2 [r sadd myset A a b c B]
+ assert_equal [lsort {A a b c B}] [lsort [r smembers myset]]
+ }
+
+ test "Set encoding after DEBUG RELOAD" {
+ r del myintset myhashset mylargeintset
+ for {set i 0} {$i < 100} {incr i} { r sadd myintset $i }
+ for {set i 0} {$i < 1280} {incr i} { r sadd mylargeintset $i }
+ for {set i 0} {$i < 256} {incr i} { r sadd myhashset [format "i%03d" $i] }
+ assert_encoding intset myintset
+ assert_encoding hashtable mylargeintset
+ assert_encoding hashtable myhashset
+
+ r debug reload
+ assert_encoding intset myintset
+ assert_encoding hashtable mylargeintset
+ assert_encoding hashtable myhashset
+ }
+
+ test {SREM basics - regular set} {
+ create_set myset {foo bar ciao}
+ assert_encoding hashtable myset
+ assert_equal 0 [r srem myset qux]
+ assert_equal 1 [r srem myset foo]
+ assert_equal {bar ciao} [lsort [r smembers myset]]
+ }
+
+ test {SREM basics - intset} {
+ create_set myset {3 4 5}
+ assert_encoding intset myset
+ assert_equal 0 [r srem myset 6]
+ assert_equal 1 [r srem myset 4]
+ assert_equal {3 5} [lsort [r smembers myset]]
+ }
+
+ test {SREM with multiple arguments} {
+ r del myset
+ r sadd myset a b c d
+ assert_equal 0 [r srem myset k k k]
+ assert_equal 2 [r srem myset b d x y]
+ lsort [r smembers myset]
+ } {a c}
+
+ test {SREM variadic version with more args needed to destroy the key} {
+ r del myset
+ r sadd myset 1 2 3
+ r srem myset 1 2 3 4 5 6 7 8
+ } {3}
+
+ foreach {type} {hashtable intset} {
+ for {set i 1} {$i <= 5} {incr i} {
+ r del [format "set%d" $i]
+ }
+ for {set i 0} {$i < 200} {incr i} {
+ r sadd set1 $i
+ r sadd set2 [expr $i+195]
+ }
+ foreach i {199 195 1000 2000} {
+ r sadd set3 $i
+ }
+ for {set i 5} {$i < 200} {incr i} {
+ r sadd set4 $i
+ }
+ r sadd set5 0
+
+ # To make sure the sets are encoded as the type we are testing -- also
+ # when the VM is enabled and the values may be swapped in and out
+ # while the tests are running -- an extra element is added to every
+ # set that determines its encoding.
+ set large 200
+ if {$type eq "hashtable"} {
+ set large foo
+ }
+
+ for {set i 1} {$i <= 5} {incr i} {
+ r sadd [format "set%d" $i] $large
+ }
+
+ test "Generated sets must be encoded as $type" {
+ for {set i 1} {$i <= 5} {incr i} {
+ assert_encoding $type [format "set%d" $i]
+ }
+ }
+
+ test "SINTER with two sets - $type" {
+ assert_equal [list 195 196 197 198 199 $large] [lsort [r sinter set1 set2]]
+ }
+
+ test "SINTERSTORE with two sets - $type" {
+ r sinterstore setres set1 set2
+ assert_encoding $type setres
+ assert_equal [list 195 196 197 198 199 $large] [lsort [r smembers setres]]
+ }
+
+ test "SINTERSTORE with two sets, after a DEBUG RELOAD - $type" {
+ r debug reload
+ r sinterstore setres set1 set2
+ assert_encoding $type setres
+ assert_equal [list 195 196 197 198 199 $large] [lsort [r smembers setres]]
+ }
+
+ test "SUNION with two sets - $type" {
+ set expected [lsort -uniq "[r smembers set1] [r smembers set2]"]
+ assert_equal $expected [lsort [r sunion set1 set2]]
+ }
+
+ test "SUNIONSTORE with two sets - $type" {
+ r sunionstore setres set1 set2
+ assert_encoding $type setres
+ set expected [lsort -uniq "[r smembers set1] [r smembers set2]"]
+ assert_equal $expected [lsort [r smembers setres]]
+ }
+
+ test "SINTER against three sets - $type" {
+ assert_equal [list 195 199 $large] [lsort [r sinter set1 set2 set3]]
+ }
+
+ test "SINTERSTORE with three sets - $type" {
+ r sinterstore setres set1 set2 set3
+ assert_equal [list 195 199 $large] [lsort [r smembers setres]]
+ }
+
+ test "SUNION with non existing keys - $type" {
+ set expected [lsort -uniq "[r smembers set1] [r smembers set2]"]
+ assert_equal $expected [lsort [r sunion nokey1 set1 set2 nokey2]]
+ }
+
+ test "SDIFF with two sets - $type" {
+ assert_equal {0 1 2 3 4} [lsort [r sdiff set1 set4]]
+ }
+
+ test "SDIFF with three sets - $type" {
+ assert_equal {1 2 3 4} [lsort [r sdiff set1 set4 set5]]
+ }
+
+ test "SDIFFSTORE with three sets - $type" {
+ r sdiffstore setres set1 set4 set5
+ # When we start with intsets, we should always end with intsets.
+ if {$type eq {intset}} {
+ assert_encoding intset setres
+ }
+ assert_equal {1 2 3 4} [lsort [r smembers setres]]
+ }
+ }
+
+ test "SDIFF with first set empty" {
+ r del set1 set2 set3
+ r sadd set2 1 2 3 4
+ r sadd set3 a b c d
+ r sdiff set1 set2 set3
+ } {}
+
+ test "SDIFF with same set two times" {
+ r del set1
+ r sadd set1 a b c 1 2 3 4 5 6
+ r sdiff set1 set1
+ } {}
+
+ test "SDIFF fuzzing" {
+ for {set j 0} {$j < 100} {incr j} {
+ unset -nocomplain s
+ array set s {}
+ set args {}
+ set num_sets [expr {[randomInt 10]+1}]
+ for {set i 0} {$i < $num_sets} {incr i} {
+ set num_elements [randomInt 100]
+ r del set_$i
+ lappend args set_$i
+ while {$num_elements} {
+ set ele [randomValue]
+ r sadd set_$i $ele
+ if {$i == 0} {
+ set s($ele) x
+ } else {
+ unset -nocomplain s($ele)
+ }
+ incr num_elements -1
+ }
+ }
+ set result [lsort [r sdiff {*}$args]]
+ assert_equal $result [lsort [array names s]]
+ }
+ }
+
+ test "SINTER against non-set should throw error" {
+ r set key1 x
+ assert_error "WRONGTYPE*" {r sinter key1 noset}
+ }
+
+ test "SUNION against non-set should throw error" {
+ r set key1 x
+ assert_error "WRONGTYPE*" {r sunion key1 noset}
+ }
+
+ test "SINTER should handle non existing key as empty" {
+ r del set1 set2 set3
+ r sadd set1 a b c
+ r sadd set2 b c d
+ r sinter set1 set2 set3
+ } {}
+
+ test "SINTER with same integer elements but different encoding" {
+ r del set1 set2
+ r sadd set1 1 2 3
+ r sadd set2 1 2 3 a
+ r srem set2 a
+ assert_encoding intset set1
+ assert_encoding hashtable set2
+ lsort [r sinter set1 set2]
+ } {1 2 3}
+
+ test "SINTERSTORE against non existing keys should delete dstkey" {
+ r set setres xxx
+ assert_equal 0 [r sinterstore setres foo111 bar222]
+ assert_equal 0 [r exists setres]
+ }
+
+ test "SUNIONSTORE against non existing keys should delete dstkey" {
+ r set setres xxx
+ assert_equal 0 [r sunionstore setres foo111 bar222]
+ assert_equal 0 [r exists setres]
+ }
+
+ foreach {type contents} {hashtable {a b c} intset {1 2 3}} {
+ test "SPOP basics - $type" {
+ create_set myset $contents
+ assert_encoding $type myset
+ assert_equal $contents [lsort [list [r spop myset] [r spop myset] [r spop myset]]]
+ assert_equal 0 [r scard myset]
+ }
+
+ test "SPOP with <count>=1 - $type" {
+ create_set myset $contents
+ assert_encoding $type myset
+ assert_equal $contents [lsort [list [r spop myset 1] [r spop myset 1] [r spop myset 1]]]
+ assert_equal 0 [r scard myset]
+ }
+
+ test "SRANDMEMBER - $type" {
+ create_set myset $contents
+ unset -nocomplain myset
+ array set myset {}
+ for {set i 0} {$i < 100} {incr i} {
+ set myset([r srandmember myset]) 1
+ }
+ assert_equal $contents [lsort [array names myset]]
+ }
+ }
+
+ foreach {type contents} {
+ hashtable {a b c d e f g h i j k l m n o p q r s t u v w x y z}
+ intset {1 10 11 12 13 14 15 16 17 18 19 2 20 21 22 23 24 25 26 3 4 5 6 7 8 9}
+ } {
+ test "SPOP with <count>" {
+ create_set myset $contents
+ assert_encoding $type myset
+ assert_equal $contents [lsort [concat [r spop myset 11] [r spop myset 9] [r spop myset 0] [r spop myset 4] [r spop myset 1] [r spop myset 0] [r spop myset 1] [r spop myset 0]]]
+ assert_equal 0 [r scard myset]
+ }
+ }
+
+ # As seen in intsetRandomMembers
+ test "SPOP using integers, testing Knuth's and Floyd's algorithm" {
+ create_set myset {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
+ assert_encoding intset myset
+ assert_equal 20 [r scard myset]
+ r spop myset 1
+ assert_equal 19 [r scard myset]
+ r spop myset 2
+ assert_equal 17 [r scard myset]
+ r spop myset 3
+ assert_equal 14 [r scard myset]
+ r spop myset 10
+ assert_equal 4 [r scard myset]
+ r spop myset 10
+ assert_equal 0 [r scard myset]
+ r spop myset 1
+ assert_equal 0 [r scard myset]
+ } {}
+
+ test "SPOP using integers with Knuth's algorithm" {
+ r spop nonexisting_key 100
+ } {}
+
+ test "SPOP new implementation: code path #1" {
+ set content {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
+ create_set myset $content
+ set res [r spop myset 30]
+ assert {[lsort $content] eq [lsort $res]}
+ }
+
+ test "SPOP new implementation: code path #2" {
+ set content {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
+ create_set myset $content
+ set res [r spop myset 2]
+ assert {[llength $res] == 2}
+ assert {[r scard myset] == 18}
+ set union [concat [r smembers myset] $res]
+ assert {[lsort $union] eq [lsort $content]}
+ }
+
+ test "SPOP new implementation: code path #3" {
+ set content {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
+ create_set myset $content
+ set res [r spop myset 18]
+ assert {[llength $res] == 18}
+ assert {[r scard myset] == 2}
+ set union [concat [r smembers myset] $res]
+ assert {[lsort $union] eq [lsort $content]}
+ }
+
+ test "SRANDMEMBER with <count> against non existing key" {
+ r srandmember nonexisting_key 100
+ } {}
+
+ foreach {type contents} {
+ hashtable {
+ 1 5 10 50 125 50000 33959417 4775547 65434162
+ 12098459 427716 483706 2726473884 72615637475
+ MARY PATRICIA LINDA BARBARA ELIZABETH JENNIFER MARIA
+ SUSAN MARGARET DOROTHY LISA NANCY KAREN BETTY HELEN
+ SANDRA DONNA CAROL RUTH SHARON MICHELLE LAURA SARAH
+ KIMBERLY DEBORAH JESSICA SHIRLEY CYNTHIA ANGELA MELISSA
+ BRENDA AMY ANNA REBECCA VIRGINIA KATHLEEN
+ }
+ intset {
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
+ 20 21 22 23 24 25 26 27 28 29
+ 30 31 32 33 34 35 36 37 38 39
+ 40 41 42 43 44 45 46 47 48 49
+ }
+ } {
+ test "SRANDMEMBER with <count> - $type" {
+ create_set myset $contents
+ unset -nocomplain myset
+ array set myset {}
+ foreach ele [r smembers myset] {
+ set myset($ele) 1
+ }
+ assert_equal [lsort $contents] [lsort [array names myset]]
+
+ # Make sure that a count of 0 is handled correctly.
+ assert_equal [r srandmember myset 0] {}
+
+ # We'll stress different parts of the code, see the implementation
+ # of SRANDMEMBER for more information, but basically there are
+ # four different code paths.
+ #
+ # PATH 1: Use negative count.
+ #
+ # 1) Check that it returns repeated elements.
+ set res [r srandmember myset -100]
+ assert_equal [llength $res] 100
+
+ # 2) Check that all the elements actually belong to the
+ # original set.
+ foreach ele $res {
+ assert {[info exists myset($ele)]}
+ }
+
+ # 3) Check that eventually all the elements are returned.
+ unset -nocomplain auxset
+ set iterations 1000
+ while {$iterations != 0} {
+ incr iterations -1
+ set res [r srandmember myset -10]
+ foreach ele $res {
+ set auxset($ele) 1
+ }
+ if {[lsort [array names myset]] eq
+ [lsort [array names auxset]]} {
+ break;
+ }
+ }
+ assert {$iterations != 0}
+
+ # PATH 2: positive count (unique behavior) with requested size
+ # equal or greater than set size.
+ foreach size {50 100} {
+ set res [r srandmember myset $size]
+ assert_equal [llength $res] 50
+ assert_equal [lsort $res] [lsort [array names myset]]
+ }
+
+ # PATH 3: Ask almost as elements as there are in the set.
+ # In this case the implementation will duplicate the original
+ # set and will remove random elements up to the requested size.
+ #
+ # PATH 4: Ask a number of elements definitely smaller than
+ # the set size.
+ #
+ # We can test both the code paths just changing the size but
+ # using the same code.
+
+ foreach size {45 5} {
+ set res [r srandmember myset $size]
+ assert_equal [llength $res] $size
+
+ # 1) Check that all the elements actually belong to the
+ # original set.
+ foreach ele $res {
+ assert {[info exists myset($ele)]}
+ }
+
+ # 2) Check that eventually all the elements are returned.
+ unset -nocomplain auxset
+ set iterations 1000
+ while {$iterations != 0} {
+ incr iterations -1
+ set res [r srandmember myset -10]
+ foreach ele $res {
+ set auxset($ele) 1
+ }
+ if {[lsort [array names myset]] eq
+ [lsort [array names auxset]]} {
+ break;
+ }
+ }
+ assert {$iterations != 0}
+ }
+ }
+ }
+
+ proc setup_move {} {
+ r del myset3 myset4
+ create_set myset1 {1 a b}
+ create_set myset2 {2 3 4}
+ assert_encoding hashtable myset1
+ assert_encoding intset myset2
+ }
+
+ test "SMOVE basics - from regular set to intset" {
+ # move a non-integer element to an intset should convert encoding
+ setup_move
+ assert_equal 1 [r smove myset1 myset2 a]
+ assert_equal {1 b} [lsort [r smembers myset1]]
+ assert_equal {2 3 4 a} [lsort [r smembers myset2]]
+ assert_encoding hashtable myset2
+
+ # move an integer element should not convert the encoding
+ setup_move
+ assert_equal 1 [r smove myset1 myset2 1]
+ assert_equal {a b} [lsort [r smembers myset1]]
+ assert_equal {1 2 3 4} [lsort [r smembers myset2]]
+ assert_encoding intset myset2
+ }
+
+ test "SMOVE basics - from intset to regular set" {
+ setup_move
+ assert_equal 1 [r smove myset2 myset1 2]
+ assert_equal {1 2 a b} [lsort [r smembers myset1]]
+ assert_equal {3 4} [lsort [r smembers myset2]]
+ }
+
+ test "SMOVE non existing key" {
+ setup_move
+ assert_equal 0 [r smove myset1 myset2 foo]
+ assert_equal 0 [r smove myset1 myset1 foo]
+ assert_equal {1 a b} [lsort [r smembers myset1]]
+ assert_equal {2 3 4} [lsort [r smembers myset2]]
+ }
+
+ test "SMOVE non existing src set" {
+ setup_move
+ assert_equal 0 [r smove noset myset2 foo]
+ assert_equal {2 3 4} [lsort [r smembers myset2]]
+ }
+
+ test "SMOVE from regular set to non existing destination set" {
+ setup_move
+ assert_equal 1 [r smove myset1 myset3 a]
+ assert_equal {1 b} [lsort [r smembers myset1]]
+ assert_equal {a} [lsort [r smembers myset3]]
+ assert_encoding hashtable myset3
+ }
+
+ test "SMOVE from intset to non existing destination set" {
+ setup_move
+ assert_equal 1 [r smove myset2 myset3 2]
+ assert_equal {3 4} [lsort [r smembers myset2]]
+ assert_equal {2} [lsort [r smembers myset3]]
+ assert_encoding intset myset3
+ }
+
+ test "SMOVE wrong src key type" {
+ r set x 10
+ assert_error "WRONGTYPE*" {r smove x myset2 foo}
+ }
+
+ test "SMOVE wrong dst key type" {
+ r set x 10
+ assert_error "WRONGTYPE*" {r smove myset2 x foo}
+ }
+
+ test "SMOVE with identical source and destination" {
+ r del set
+ r sadd set a b c
+ r smove set set b
+ lsort [r smembers set]
+ } {a b c}
+
+ tags {slow} {
+ test {intsets implementation stress testing} {
+ for {set j 0} {$j < 20} {incr j} {
+ unset -nocomplain s
+ array set s {}
+ r del s
+ set len [randomInt 1024]
+ for {set i 0} {$i < $len} {incr i} {
+ randpath {
+ set data [randomInt 65536]
+ } {
+ set data [randomInt 4294967296]
+ } {
+ set data [randomInt 18446744073709551616]
+ }
+ set s($data) {}
+ r sadd s $data
+ }
+ assert_equal [lsort [r smembers s]] [lsort [array names s]]
+ set len [array size s]
+ for {set i 0} {$i < $len} {incr i} {
+ set e [r spop s]
+ if {![info exists s($e)]} {
+ puts "Can't find '$e' on local array"
+ puts "Local array: [lsort [r smembers s]]"
+ puts "Remote array: [lsort [array names s]]"
+ error "exception"
+ }
+ array unset s $e
+ }
+ assert_equal [r scard s] 0
+ assert_equal [array size s] 0
+ }
+ }
+ }
+}
diff --git a/tests/unit/type/string.tcl b/tests/unit/type/string.tcl
new file mode 100644
index 0000000..7122fd9
--- /dev/null
+++ b/tests/unit/type/string.tcl
@@ -0,0 +1,422 @@
+start_server {tags {"string"}} {
+ test {SET and GET an item} {
+ r set x foobar
+ r get x
+ } {foobar}
+
+ test {SET and GET an empty item} {
+ r set x {}
+ r get x
+ } {}
+
+ test {Very big payload in GET/SET} {
+ set buf [string repeat "abcd" 1000000]
+ r set foo $buf
+ r get foo
+ } [string repeat "abcd" 1000000]
+
+ tags {"slow"} {
+ test {Very big payload random access} {
+ set err {}
+ array set payload {}
+ for {set j 0} {$j < 100} {incr j} {
+ set size [expr 1+[randomInt 100000]]
+ set buf [string repeat "pl-$j" $size]
+ set payload($j) $buf
+ r set bigpayload_$j $buf
+ }
+ for {set j 0} {$j < 1000} {incr j} {
+ set index [randomInt 100]
+ set buf [r get bigpayload_$index]
+ if {$buf != $payload($index)} {
+ set err "Values differ: I set '$payload($index)' but I read back '$buf'"
+ break
+ }
+ }
+ unset payload
+ set _ $err
+ } {}
+
+ test {SET 10000 numeric keys and access all them in reverse order} {
+ r flushdb
+ set err {}
+ for {set x 0} {$x < 10000} {incr x} {
+ r set $x $x
+ }
+ set sum 0
+ for {set x 9999} {$x >= 0} {incr x -1} {
+ set val [r get $x]
+ if {$val ne $x} {
+ set err "Element at position $x is $val instead of $x"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ test {DBSIZE should be 10000 now} {
+ r dbsize
+ } {10000}
+ }
+
+ test "SETNX target key missing" {
+ r del novar
+ assert_equal 1 [r setnx novar foobared]
+ assert_equal "foobared" [r get novar]
+ }
+
+ test "SETNX target key exists" {
+ r set novar foobared
+ assert_equal 0 [r setnx novar blabla]
+ assert_equal "foobared" [r get novar]
+ }
+
+ test "SETNX against not-expired volatile key" {
+ r set x 10
+ r expire x 10000
+ assert_equal 0 [r setnx x 20]
+ assert_equal 10 [r get x]
+ }
+
+ test "SETNX against expired volatile key" {
+ # Make it very unlikely for the key this test uses to be expired by the
+ # active expiry cycle. This is tightly coupled to the implementation of
+ # active expiry and dbAdd() but currently the only way to test that
+ # SETNX expires a key when it should have been.
+ for {set x 0} {$x < 9999} {incr x} {
+ r setex key-$x 3600 value
+ }
+
+ # This will be one of 10000 expiring keys. A cycle is executed every
+ # 100ms, sampling 10 keys for being expired or not. This key will be
+ # expired for at most 1s when we wait 2s, resulting in a total sample
+ # of 100 keys. The probability of the success of this test being a
+ # false positive is therefore approx. 1%.
+ r set x 10
+ r expire x 1
+
+ # Wait for the key to expire
+ after 2000
+
+ assert_equal 1 [r setnx x 20]
+ assert_equal 20 [r get x]
+ }
+
+ test {MGET} {
+ r flushdb
+ r set foo BAR
+ r set bar FOO
+ r mget foo bar
+ } {BAR FOO}
+
+ test {MGET against non existing key} {
+ r mget foo baazz bar
+ } {BAR {} FOO}
+
+ test {MGET against non-string key} {
+ r sadd myset ciao
+ r sadd myset bau
+ r mget foo baazz bar myset
+ } {BAR {} FOO {}}
+
+ test {GETSET (set new value)} {
+ r del foo
+ list [r getset foo xyz] [r get foo]
+ } {{} xyz}
+
+ test {GETSET (replace old value)} {
+ r set foo bar
+ list [r getset foo xyz] [r get foo]
+ } {bar xyz}
+
+ test {MSET base case} {
+ r mset x 10 y "foo bar" z "x x x x x x x\n\n\r\n"
+ r mget x y z
+ } [list 10 {foo bar} "x x x x x x x\n\n\r\n"]
+
+ test {MSET wrong number of args} {
+ catch {r mset x 10 y "foo bar" z} err
+ format $err
+ } {*wrong number*}
+
+ test {MSETNX with already existent key} {
+ list [r msetnx x1 xxx y2 yyy x 20] [r exists x1] [r exists y2]
+ } {0 0 0}
+
+ test {MSETNX with not existing keys} {
+ list [r msetnx x1 xxx y2 yyy] [r get x1] [r get y2]
+ } {1 xxx yyy}
+
+ test "STRLEN against non-existing key" {
+ assert_equal 0 [r strlen notakey]
+ }
+
+ test "STRLEN against integer-encoded value" {
+ r set myinteger -555
+ assert_equal 4 [r strlen myinteger]
+ }
+
+ test "STRLEN against plain string" {
+ r set mystring "foozzz0123456789 baz"
+ assert_equal 20 [r strlen mystring]
+ }
+
+ test "SETBIT against non-existing key" {
+ r del mykey
+ assert_equal 0 [r setbit mykey 1 1]
+ assert_equal [binary format B* 01000000] [r get mykey]
+ }
+
+ test "SETBIT against string-encoded key" {
+ # Ascii "@" is integer 64 = 01 00 00 00
+ r set mykey "@"
+
+ assert_equal 0 [r setbit mykey 2 1]
+ assert_equal [binary format B* 01100000] [r get mykey]
+ assert_equal 1 [r setbit mykey 1 0]
+ assert_equal [binary format B* 00100000] [r get mykey]
+ }
+
+ test "SETBIT against integer-encoded key" {
+ # Ascii "1" is integer 49 = 00 11 00 01
+ r set mykey 1
+ assert_encoding int mykey
+
+ assert_equal 0 [r setbit mykey 6 1]
+ assert_equal [binary format B* 00110011] [r get mykey]
+ assert_equal 1 [r setbit mykey 2 0]
+ assert_equal [binary format B* 00010011] [r get mykey]
+ }
+
+ test "SETBIT against key with wrong type" {
+ r del mykey
+ r lpush mykey "foo"
+ assert_error "WRONGTYPE*" {r setbit mykey 0 1}
+ }
+
+ test "SETBIT with out of range bit offset" {
+ r del mykey
+ assert_error "*out of range*" {r setbit mykey [expr 4*1024*1024*1024] 1}
+ assert_error "*out of range*" {r setbit mykey -1 1}
+ }
+
+ test "SETBIT with non-bit argument" {
+ r del mykey
+ assert_error "*out of range*" {r setbit mykey 0 -1}
+ assert_error "*out of range*" {r setbit mykey 0 2}
+ assert_error "*out of range*" {r setbit mykey 0 10}
+ assert_error "*out of range*" {r setbit mykey 0 20}
+ }
+
+ test "SETBIT fuzzing" {
+ set str ""
+ set len [expr 256*8]
+ r del mykey
+
+ for {set i 0} {$i < 2000} {incr i} {
+ set bitnum [randomInt $len]
+ set bitval [randomInt 2]
+ set fmt [format "%%-%ds%%d%%-s" $bitnum]
+ set head [string range $str 0 $bitnum-1]
+ set tail [string range $str $bitnum+1 end]
+ set str [string map {" " 0} [format $fmt $head $bitval $tail]]
+
+ r setbit mykey $bitnum $bitval
+ assert_equal [binary format B* $str] [r get mykey]
+ }
+ }
+
+ test "GETBIT against non-existing key" {
+ r del mykey
+ assert_equal 0 [r getbit mykey 0]
+ }
+
+ test "GETBIT against string-encoded key" {
+ # Single byte with 2nd and 3rd bit set
+ r set mykey "`"
+
+ # In-range
+ assert_equal 0 [r getbit mykey 0]
+ assert_equal 1 [r getbit mykey 1]
+ assert_equal 1 [r getbit mykey 2]
+ assert_equal 0 [r getbit mykey 3]
+
+ # Out-range
+ assert_equal 0 [r getbit mykey 8]
+ assert_equal 0 [r getbit mykey 100]
+ assert_equal 0 [r getbit mykey 10000]
+ }
+
+ test "GETBIT against integer-encoded key" {
+ r set mykey 1
+ assert_encoding int mykey
+
+ # Ascii "1" is integer 49 = 00 11 00 01
+ assert_equal 0 [r getbit mykey 0]
+ assert_equal 0 [r getbit mykey 1]
+ assert_equal 1 [r getbit mykey 2]
+ assert_equal 1 [r getbit mykey 3]
+
+ # Out-range
+ assert_equal 0 [r getbit mykey 8]
+ assert_equal 0 [r getbit mykey 100]
+ assert_equal 0 [r getbit mykey 10000]
+ }
+
+ test "SETRANGE against non-existing key" {
+ r del mykey
+ assert_equal 3 [r setrange mykey 0 foo]
+ assert_equal "foo" [r get mykey]
+
+ r del mykey
+ assert_equal 0 [r setrange mykey 0 ""]
+ assert_equal 0 [r exists mykey]
+
+ r del mykey
+ assert_equal 4 [r setrange mykey 1 foo]
+ assert_equal "\000foo" [r get mykey]
+ }
+
+ test "SETRANGE against string-encoded key" {
+ r set mykey "foo"
+ assert_equal 3 [r setrange mykey 0 b]
+ assert_equal "boo" [r get mykey]
+
+ r set mykey "foo"
+ assert_equal 3 [r setrange mykey 0 ""]
+ assert_equal "foo" [r get mykey]
+
+ r set mykey "foo"
+ assert_equal 3 [r setrange mykey 1 b]
+ assert_equal "fbo" [r get mykey]
+
+ r set mykey "foo"
+ assert_equal 7 [r setrange mykey 4 bar]
+ assert_equal "foo\000bar" [r get mykey]
+ }
+
+ test "SETRANGE against integer-encoded key" {
+ r set mykey 1234
+ assert_encoding int mykey
+ assert_equal 4 [r setrange mykey 0 2]
+ assert_encoding raw mykey
+ assert_equal 2234 [r get mykey]
+
+ # Shouldn't change encoding when nothing is set
+ r set mykey 1234
+ assert_encoding int mykey
+ assert_equal 4 [r setrange mykey 0 ""]
+ assert_encoding int mykey
+ assert_equal 1234 [r get mykey]
+
+ r set mykey 1234
+ assert_encoding int mykey
+ assert_equal 4 [r setrange mykey 1 3]
+ assert_encoding raw mykey
+ assert_equal 1334 [r get mykey]
+
+ r set mykey 1234
+ assert_encoding int mykey
+ assert_equal 6 [r setrange mykey 5 2]
+ assert_encoding raw mykey
+ assert_equal "1234\0002" [r get mykey]
+ }
+
+ test "SETRANGE against key with wrong type" {
+ r del mykey
+ r lpush mykey "foo"
+ assert_error "WRONGTYPE*" {r setrange mykey 0 bar}
+ }
+
+ test "SETRANGE with out of range offset" {
+ r del mykey
+ assert_error "*maximum allowed size*" {r setrange mykey [expr 512*1024*1024-4] world}
+
+ r set mykey "hello"
+ assert_error "*out of range*" {r setrange mykey -1 world}
+ assert_error "*maximum allowed size*" {r setrange mykey [expr 512*1024*1024-4] world}
+ }
+
+ test "GETRANGE against non-existing key" {
+ r del mykey
+ assert_equal "" [r getrange mykey 0 -1]
+ }
+
+ test "GETRANGE against string value" {
+ r set mykey "Hello World"
+ assert_equal "Hell" [r getrange mykey 0 3]
+ assert_equal "Hello World" [r getrange mykey 0 -1]
+ assert_equal "orld" [r getrange mykey -4 -1]
+ assert_equal "" [r getrange mykey 5 3]
+ assert_equal " World" [r getrange mykey 5 5000]
+ assert_equal "Hello World" [r getrange mykey -5000 10000]
+ }
+
+ test "GETRANGE against integer-encoded value" {
+ r set mykey 1234
+ assert_equal "123" [r getrange mykey 0 2]
+ assert_equal "1234" [r getrange mykey 0 -1]
+ assert_equal "234" [r getrange mykey -3 -1]
+ assert_equal "" [r getrange mykey 5 3]
+ assert_equal "4" [r getrange mykey 3 5000]
+ assert_equal "1234" [r getrange mykey -5000 10000]
+ }
+
+ test "GETRANGE fuzzing" {
+ for {set i 0} {$i < 1000} {incr i} {
+ r set bin [set bin [randstring 0 1024 binary]]
+ set _start [set start [randomInt 1500]]
+ set _end [set end [randomInt 1500]]
+ if {$_start < 0} {set _start "end-[abs($_start)-1]"}
+ if {$_end < 0} {set _end "end-[abs($_end)-1]"}
+ assert_equal [string range $bin $_start $_end] [r getrange bin $start $end]
+ }
+ }
+
+ test {Extended SET can detect syntax errors} {
+ set e {}
+ catch {r set foo bar non-existing-option} e
+ set e
+ } {*syntax*}
+
+ test {Extended SET NX option} {
+ r del foo
+ set v1 [r set foo 1 nx]
+ set v2 [r set foo 2 nx]
+ list $v1 $v2 [r get foo]
+ } {OK {} 1}
+
+ test {Extended SET XX option} {
+ r del foo
+ set v1 [r set foo 1 xx]
+ r set foo bar
+ set v2 [r set foo 2 xx]
+ list $v1 $v2 [r get foo]
+ } {{} OK 2}
+
+ test {Extended SET EX option} {
+ r del foo
+ r set foo bar ex 10
+ set ttl [r ttl foo]
+ assert {$ttl <= 10 && $ttl > 5}
+ }
+
+ test {Extended SET PX option} {
+ r del foo
+ r set foo bar px 10000
+ set ttl [r ttl foo]
+ assert {$ttl <= 10 && $ttl > 5}
+ }
+
+ test {Extended SET using multiple options at once} {
+ r set foo val
+ assert {[r set foo bar xx px 10000] eq {OK}}
+ set ttl [r ttl foo]
+ assert {$ttl <= 10 && $ttl > 5}
+ }
+
+ test {GETRANGE with huge ranges, Github issue #1844} {
+ r set foo bar
+ r getrange foo 0 4294967297
+ } {bar}
+}
diff --git a/tests/unit/type/zset.tcl b/tests/unit/type/zset.tcl
new file mode 100644
index 0000000..82f76be
--- /dev/null
+++ b/tests/unit/type/zset.tcl
@@ -0,0 +1,1030 @@
+start_server {tags {"zset"}} {
+ proc create_zset {key items} {
+ r del $key
+ foreach {score entry} $items {
+ r zadd $key $score $entry
+ }
+ }
+
+ proc basics {encoding} {
+ if {$encoding == "ziplist"} {
+ r config set zset-max-ziplist-entries 128
+ r config set zset-max-ziplist-value 64
+ } elseif {$encoding == "skiplist"} {
+ r config set zset-max-ziplist-entries 0
+ r config set zset-max-ziplist-value 0
+ } else {
+ puts "Unknown sorted set encoding"
+ exit
+ }
+
+ test "Check encoding - $encoding" {
+ r del ztmp
+ r zadd ztmp 10 x
+ assert_encoding $encoding ztmp
+ }
+
+ test "ZSET basic ZADD and score update - $encoding" {
+ r del ztmp
+ r zadd ztmp 10 x
+ r zadd ztmp 20 y
+ r zadd ztmp 30 z
+ assert_equal {x y z} [r zrange ztmp 0 -1]
+
+ r zadd ztmp 1 y
+ assert_equal {y x z} [r zrange ztmp 0 -1]
+ }
+
+ test "ZSET element can't be set to NaN with ZADD - $encoding" {
+ assert_error "*not*float*" {r zadd myzset nan abc}
+ }
+
+ test "ZSET element can't be set to NaN with ZINCRBY" {
+ assert_error "*not*float*" {r zadd myzset nan abc}
+ }
+
+ test "ZADD with options syntax error with incomplete pair" {
+ r del ztmp
+ catch {r zadd ztmp xx 10 x 20} err
+ set err
+ } {ERR*}
+
+ test "ZADD XX option without key - $encoding" {
+ r del ztmp
+ assert {[r zadd ztmp xx 10 x] == 0}
+ assert {[r type ztmp] eq {none}}
+ }
+
+ test "ZADD XX existing key - $encoding" {
+ r del ztmp
+ r zadd ztmp 10 x
+ assert {[r zadd ztmp xx 20 y] == 0}
+ assert {[r zcard ztmp] == 1}
+ }
+
+ test "ZADD XX returns the number of elements actually added" {
+ r del ztmp
+ r zadd ztmp 10 x
+ set retval [r zadd ztmp 10 x 20 y 30 z]
+ assert {$retval == 2}
+ }
+
+ test "ZADD XX updates existing elements score" {
+ r del ztmp
+ r zadd ztmp 10 x 20 y 30 z
+ r zadd ztmp xx 5 foo 11 x 21 y 40 zap
+ assert {[r zcard ztmp] == 3}
+ assert {[r zscore ztmp x] == 11}
+ assert {[r zscore ztmp y] == 21}
+ }
+
+ test "ZADD XX and NX are not compatible" {
+ r del ztmp
+ catch {r zadd ztmp xx nx 10 x} err
+ set err
+ } {ERR*}
+
+ test "ZADD NX with non exisitng key" {
+ r del ztmp
+ r zadd ztmp nx 10 x 20 y 30 z
+ assert {[r zcard ztmp] == 3}
+ }
+
+ test "ZADD NX only add new elements without updating old ones" {
+ r del ztmp
+ r zadd ztmp 10 x 20 y 30 z
+ assert {[r zadd ztmp nx 11 x 21 y 100 a 200 b] == 2}
+ assert {[r zscore ztmp x] == 10}
+ assert {[r zscore ztmp y] == 20}
+ assert {[r zscore ztmp a] == 100}
+ assert {[r zscore ztmp b] == 200}
+ }
+
+ test "ZADD INCR works like ZINCRBY" {
+ r del ztmp
+ r zadd ztmp 10 x 20 y 30 z
+ r zadd ztmp INCR 15 x
+ assert {[r zscore ztmp x] == 25}
+ }
+
+ test "ZADD INCR works with a single score-elemenet pair" {
+ r del ztmp
+ r zadd ztmp 10 x 20 y 30 z
+ catch {r zadd ztmp INCR 15 x 10 y} err
+ set err
+ } {ERR*}
+
+ test "ZADD CH option changes return value to all changed elements" {
+ r del ztmp
+ r zadd ztmp 10 x 20 y 30 z
+ assert {[r zadd ztmp 11 x 21 y 30 z] == 0}
+ assert {[r zadd ztmp ch 12 x 22 y 30 z] == 2}
+ }
+
+ test "ZINCRBY calls leading to NaN result in error" {
+ r zincrby myzset +inf abc
+ assert_error "*NaN*" {r zincrby myzset -inf abc}
+ }
+
+ test {ZADD - Variadic version base case} {
+ r del myzset
+ list [r zadd myzset 10 a 20 b 30 c] [r zrange myzset 0 -1 withscores]
+ } {3 {a 10 b 20 c 30}}
+
+ test {ZADD - Return value is the number of actually added items} {
+ list [r zadd myzset 5 x 20 b 30 c] [r zrange myzset 0 -1 withscores]
+ } {1 {x 5 a 10 b 20 c 30}}
+
+ test {ZADD - Variadic version does not add nothing on single parsing err} {
+ r del myzset
+ catch {r zadd myzset 10 a 20 b 30.badscore c} e
+ assert_match {*ERR*not*float*} $e
+ r exists myzset
+ } {0}
+
+ test {ZADD - Variadic version will raise error on missing arg} {
+ r del myzset
+ catch {r zadd myzset 10 a 20 b 30 c 40} e
+ assert_match {*ERR*syntax*} $e
+ }
+
+ test {ZINCRBY does not work variadic even if shares ZADD implementation} {
+ r del myzset
+ catch {r zincrby myzset 10 a 20 b 30 c} e
+ assert_match {*ERR*wrong*number*arg*} $e
+ }
+
+ test "ZCARD basics - $encoding" {
+ r del ztmp
+ r zadd ztmp 10 a 20 b 30 c
+ assert_equal 3 [r zcard ztmp]
+ assert_equal 0 [r zcard zdoesntexist]
+ }
+
+ test "ZREM removes key after last element is removed" {
+ r del ztmp
+ r zadd ztmp 10 x
+ r zadd ztmp 20 y
+
+ assert_equal 1 [r exists ztmp]
+ assert_equal 0 [r zrem ztmp z]
+ assert_equal 1 [r zrem ztmp y]
+ assert_equal 1 [r zrem ztmp x]
+ assert_equal 0 [r exists ztmp]
+ }
+
+ test "ZREM variadic version" {
+ r del ztmp
+ r zadd ztmp 10 a 20 b 30 c
+ assert_equal 2 [r zrem ztmp x y a b k]
+ assert_equal 0 [r zrem ztmp foo bar]
+ assert_equal 1 [r zrem ztmp c]
+ r exists ztmp
+ } {0}
+
+ test "ZREM variadic version -- remove elements after key deletion" {
+ r del ztmp
+ r zadd ztmp 10 a 20 b 30 c
+ r zrem ztmp a b c d e f g
+ } {3}
+
+ test "ZRANGE basics - $encoding" {
+ r del ztmp
+ r zadd ztmp 1 a
+ r zadd ztmp 2 b
+ r zadd ztmp 3 c
+ r zadd ztmp 4 d
+
+ assert_equal {a b c d} [r zrange ztmp 0 -1]
+ assert_equal {a b c} [r zrange ztmp 0 -2]
+ assert_equal {b c d} [r zrange ztmp 1 -1]
+ assert_equal {b c} [r zrange ztmp 1 -2]
+ assert_equal {c d} [r zrange ztmp -2 -1]
+ assert_equal {c} [r zrange ztmp -2 -2]
+
+ # out of range start index
+ assert_equal {a b c} [r zrange ztmp -5 2]
+ assert_equal {a b} [r zrange ztmp -5 1]
+ assert_equal {} [r zrange ztmp 5 -1]
+ assert_equal {} [r zrange ztmp 5 -2]
+
+ # out of range end index
+ assert_equal {a b c d} [r zrange ztmp 0 5]
+ assert_equal {b c d} [r zrange ztmp 1 5]
+ assert_equal {} [r zrange ztmp 0 -5]
+ assert_equal {} [r zrange ztmp 1 -5]
+
+ # withscores
+ assert_equal {a 1 b 2 c 3 d 4} [r zrange ztmp 0 -1 withscores]
+ }
+
+ test "ZREVRANGE basics - $encoding" {
+ r del ztmp
+ r zadd ztmp 1 a
+ r zadd ztmp 2 b
+ r zadd ztmp 3 c
+ r zadd ztmp 4 d
+
+ assert_equal {d c b a} [r zrevrange ztmp 0 -1]
+ assert_equal {d c b} [r zrevrange ztmp 0 -2]
+ assert_equal {c b a} [r zrevrange ztmp 1 -1]
+ assert_equal {c b} [r zrevrange ztmp 1 -2]
+ assert_equal {b a} [r zrevrange ztmp -2 -1]
+ assert_equal {b} [r zrevrange ztmp -2 -2]
+
+ # out of range start index
+ assert_equal {d c b} [r zrevrange ztmp -5 2]
+ assert_equal {d c} [r zrevrange ztmp -5 1]
+ assert_equal {} [r zrevrange ztmp 5 -1]
+ assert_equal {} [r zrevrange ztmp 5 -2]
+
+ # out of range end index
+ assert_equal {d c b a} [r zrevrange ztmp 0 5]
+ assert_equal {c b a} [r zrevrange ztmp 1 5]
+ assert_equal {} [r zrevrange ztmp 0 -5]
+ assert_equal {} [r zrevrange ztmp 1 -5]
+
+ # withscores
+ assert_equal {d 4 c 3 b 2 a 1} [r zrevrange ztmp 0 -1 withscores]
+ }
+
+ test "ZRANK/ZREVRANK basics - $encoding" {
+ r del zranktmp
+ r zadd zranktmp 10 x
+ r zadd zranktmp 20 y
+ r zadd zranktmp 30 z
+ assert_equal 0 [r zrank zranktmp x]
+ assert_equal 1 [r zrank zranktmp y]
+ assert_equal 2 [r zrank zranktmp z]
+ assert_equal "" [r zrank zranktmp foo]
+ assert_equal 2 [r zrevrank zranktmp x]
+ assert_equal 1 [r zrevrank zranktmp y]
+ assert_equal 0 [r zrevrank zranktmp z]
+ assert_equal "" [r zrevrank zranktmp foo]
+ }
+
+ test "ZRANK - after deletion - $encoding" {
+ r zrem zranktmp y
+ assert_equal 0 [r zrank zranktmp x]
+ assert_equal 1 [r zrank zranktmp z]
+ }
+
+ test "ZINCRBY - can create a new sorted set - $encoding" {
+ r del zset
+ r zincrby zset 1 foo
+ assert_equal {foo} [r zrange zset 0 -1]
+ assert_equal 1 [r zscore zset foo]
+ }
+
+ test "ZINCRBY - increment and decrement - $encoding" {
+ r zincrby zset 2 foo
+ r zincrby zset 1 bar
+ assert_equal {bar foo} [r zrange zset 0 -1]
+
+ r zincrby zset 10 bar
+ r zincrby zset -5 foo
+ r zincrby zset -5 bar
+ assert_equal {foo bar} [r zrange zset 0 -1]
+
+ assert_equal -2 [r zscore zset foo]
+ assert_equal 6 [r zscore zset bar]
+ }
+
+ test "ZINCRBY return value" {
+ r del ztmp
+ set retval [r zincrby ztmp 1.0 x]
+ assert {$retval == 1.0}
+ }
+
+ proc create_default_zset {} {
+ create_zset zset {-inf a 1 b 2 c 3 d 4 e 5 f +inf g}
+ }
+
+ test "ZRANGEBYSCORE/ZREVRANGEBYSCORE/ZCOUNT basics" {
+ create_default_zset
+
+ # inclusive range
+ assert_equal {a b c} [r zrangebyscore zset -inf 2]
+ assert_equal {b c d} [r zrangebyscore zset 0 3]
+ assert_equal {d e f} [r zrangebyscore zset 3 6]
+ assert_equal {e f g} [r zrangebyscore zset 4 +inf]
+ assert_equal {c b a} [r zrevrangebyscore zset 2 -inf]
+ assert_equal {d c b} [r zrevrangebyscore zset 3 0]
+ assert_equal {f e d} [r zrevrangebyscore zset 6 3]
+ assert_equal {g f e} [r zrevrangebyscore zset +inf 4]
+ assert_equal 3 [r zcount zset 0 3]
+
+ # exclusive range
+ assert_equal {b} [r zrangebyscore zset (-inf (2]
+ assert_equal {b c} [r zrangebyscore zset (0 (3]
+ assert_equal {e f} [r zrangebyscore zset (3 (6]
+ assert_equal {f} [r zrangebyscore zset (4 (+inf]
+ assert_equal {b} [r zrevrangebyscore zset (2 (-inf]
+ assert_equal {c b} [r zrevrangebyscore zset (3 (0]
+ assert_equal {f e} [r zrevrangebyscore zset (6 (3]
+ assert_equal {f} [r zrevrangebyscore zset (+inf (4]
+ assert_equal 2 [r zcount zset (0 (3]
+
+ # test empty ranges
+ r zrem zset a
+ r zrem zset g
+
+ # inclusive
+ assert_equal {} [r zrangebyscore zset 4 2]
+ assert_equal {} [r zrangebyscore zset 6 +inf]
+ assert_equal {} [r zrangebyscore zset -inf -6]
+ assert_equal {} [r zrevrangebyscore zset +inf 6]
+ assert_equal {} [r zrevrangebyscore zset -6 -inf]
+
+ # exclusive
+ assert_equal {} [r zrangebyscore zset (4 (2]
+ assert_equal {} [r zrangebyscore zset 2 (2]
+ assert_equal {} [r zrangebyscore zset (2 2]
+ assert_equal {} [r zrangebyscore zset (6 (+inf]
+ assert_equal {} [r zrangebyscore zset (-inf (-6]
+ assert_equal {} [r zrevrangebyscore zset (+inf (6]
+ assert_equal {} [r zrevrangebyscore zset (-6 (-inf]
+
+ # empty inner range
+ assert_equal {} [r zrangebyscore zset 2.4 2.6]
+ assert_equal {} [r zrangebyscore zset (2.4 2.6]
+ assert_equal {} [r zrangebyscore zset 2.4 (2.6]
+ assert_equal {} [r zrangebyscore zset (2.4 (2.6]
+ }
+
+ test "ZRANGEBYSCORE with WITHSCORES" {
+ create_default_zset
+ assert_equal {b 1 c 2 d 3} [r zrangebyscore zset 0 3 withscores]
+ assert_equal {d 3 c 2 b 1} [r zrevrangebyscore zset 3 0 withscores]
+ }
+
+ test "ZRANGEBYSCORE with LIMIT" {
+ create_default_zset
+ assert_equal {b c} [r zrangebyscore zset 0 10 LIMIT 0 2]
+ assert_equal {d e f} [r zrangebyscore zset 0 10 LIMIT 2 3]
+ assert_equal {d e f} [r zrangebyscore zset 0 10 LIMIT 2 10]
+ assert_equal {} [r zrangebyscore zset 0 10 LIMIT 20 10]
+ assert_equal {f e} [r zrevrangebyscore zset 10 0 LIMIT 0 2]
+ assert_equal {d c b} [r zrevrangebyscore zset 10 0 LIMIT 2 3]
+ assert_equal {d c b} [r zrevrangebyscore zset 10 0 LIMIT 2 10]
+ assert_equal {} [r zrevrangebyscore zset 10 0 LIMIT 20 10]
+ }
+
+ test "ZRANGEBYSCORE with LIMIT and WITHSCORES" {
+ create_default_zset
+ assert_equal {e 4 f 5} [r zrangebyscore zset 2 5 LIMIT 2 3 WITHSCORES]
+ assert_equal {d 3 c 2} [r zrevrangebyscore zset 5 2 LIMIT 2 3 WITHSCORES]
+ }
+
+ test "ZRANGEBYSCORE with non-value min or max" {
+ assert_error "*not*float*" {r zrangebyscore fooz str 1}
+ assert_error "*not*float*" {r zrangebyscore fooz 1 str}
+ assert_error "*not*float*" {r zrangebyscore fooz 1 NaN}
+ }
+
+ proc create_default_lex_zset {} {
+ create_zset zset {0 alpha 0 bar 0 cool 0 down
+ 0 elephant 0 foo 0 great 0 hill
+ 0 omega}
+ }
+
+ test "ZRANGEBYLEX/ZREVRANGEBYLEX/ZCOUNT basics" {
+ create_default_lex_zset
+
+ # inclusive range
+ assert_equal {alpha bar cool} [r zrangebylex zset - \[cool]
+ assert_equal {bar cool down} [r zrangebylex zset \[bar \[down]
+ assert_equal {great hill omega} [r zrangebylex zset \[g +]
+ assert_equal {cool bar alpha} [r zrevrangebylex zset \[cool -]
+ assert_equal {down cool bar} [r zrevrangebylex zset \[down \[bar]
+ assert_equal {omega hill great foo elephant down} [r zrevrangebylex zset + \[d]
+ assert_equal 3 [r zlexcount zset \[ele \[h]
+
+ # exclusive range
+ assert_equal {alpha bar} [r zrangebylex zset - (cool]
+ assert_equal {cool} [r zrangebylex zset (bar (down]
+ assert_equal {hill omega} [r zrangebylex zset (great +]
+ assert_equal {bar alpha} [r zrevrangebylex zset (cool -]
+ assert_equal {cool} [r zrevrangebylex zset (down (bar]
+ assert_equal {omega hill} [r zrevrangebylex zset + (great]
+ assert_equal 2 [r zlexcount zset (ele (great]
+
+ # inclusive and exclusive
+ assert_equal {} [r zrangebylex zset (az (b]
+ assert_equal {} [r zrangebylex zset (z +]
+ assert_equal {} [r zrangebylex zset - \[aaaa]
+ assert_equal {} [r zrevrangebylex zset \[elez \[elex]
+ assert_equal {} [r zrevrangebylex zset (hill (omega]
+ }
+
+ test "ZRANGEBYSLEX with LIMIT" {
+ create_default_lex_zset
+ assert_equal {alpha bar} [r zrangebylex zset - \[cool LIMIT 0 2]
+ assert_equal {bar cool} [r zrangebylex zset - \[cool LIMIT 1 2]
+ assert_equal {} [r zrangebylex zset \[bar \[down LIMIT 0 0]
+ assert_equal {} [r zrangebylex zset \[bar \[down LIMIT 2 0]
+ assert_equal {bar} [r zrangebylex zset \[bar \[down LIMIT 0 1]
+ assert_equal {cool} [r zrangebylex zset \[bar \[down LIMIT 1 1]
+ assert_equal {bar cool down} [r zrangebylex zset \[bar \[down LIMIT 0 100]
+ assert_equal {omega hill great foo elephant} [r zrevrangebylex zset + \[d LIMIT 0 5]
+ assert_equal {omega hill great foo} [r zrevrangebylex zset + \[d LIMIT 0 4]
+ }
+
+ test "ZRANGEBYLEX with invalid lex range specifiers" {
+ assert_error "*not*string*" {r zrangebylex fooz foo bar}
+ assert_error "*not*string*" {r zrangebylex fooz \[foo bar}
+ assert_error "*not*string*" {r zrangebylex fooz foo \[bar}
+ assert_error "*not*string*" {r zrangebylex fooz +x \[bar}
+ assert_error "*not*string*" {r zrangebylex fooz -x \[bar}
+ }
+
+ test "ZREMRANGEBYSCORE basics" {
+ proc remrangebyscore {min max} {
+ create_zset zset {1 a 2 b 3 c 4 d 5 e}
+ assert_equal 1 [r exists zset]
+ r zremrangebyscore zset $min $max
+ }
+
+ # inner range
+ assert_equal 3 [remrangebyscore 2 4]
+ assert_equal {a e} [r zrange zset 0 -1]
+
+ # start underflow
+ assert_equal 1 [remrangebyscore -10 1]
+ assert_equal {b c d e} [r zrange zset 0 -1]
+
+ # end overflow
+ assert_equal 1 [remrangebyscore 5 10]
+ assert_equal {a b c d} [r zrange zset 0 -1]
+
+ # switch min and max
+ assert_equal 0 [remrangebyscore 4 2]
+ assert_equal {a b c d e} [r zrange zset 0 -1]
+
+ # -inf to mid
+ assert_equal 3 [remrangebyscore -inf 3]
+ assert_equal {d e} [r zrange zset 0 -1]
+
+ # mid to +inf
+ assert_equal 3 [remrangebyscore 3 +inf]
+ assert_equal {a b} [r zrange zset 0 -1]
+
+ # -inf to +inf
+ assert_equal 5 [remrangebyscore -inf +inf]
+ assert_equal {} [r zrange zset 0 -1]
+
+ # exclusive min
+ assert_equal 4 [remrangebyscore (1 5]
+ assert_equal {a} [r zrange zset 0 -1]
+ assert_equal 3 [remrangebyscore (2 5]
+ assert_equal {a b} [r zrange zset 0 -1]
+
+ # exclusive max
+ assert_equal 4 [remrangebyscore 1 (5]
+ assert_equal {e} [r zrange zset 0 -1]
+ assert_equal 3 [remrangebyscore 1 (4]
+ assert_equal {d e} [r zrange zset 0 -1]
+
+ # exclusive min and max
+ assert_equal 3 [remrangebyscore (1 (5]
+ assert_equal {a e} [r zrange zset 0 -1]
+
+ # destroy when empty
+ assert_equal 5 [remrangebyscore 1 5]
+ assert_equal 0 [r exists zset]
+ }
+
+ test "ZREMRANGEBYSCORE with non-value min or max" {
+ assert_error "*not*float*" {r zremrangebyscore fooz str 1}
+ assert_error "*not*float*" {r zremrangebyscore fooz 1 str}
+ assert_error "*not*float*" {r zremrangebyscore fooz 1 NaN}
+ }
+
+ test "ZREMRANGEBYRANK basics" {
+ proc remrangebyrank {min max} {
+ create_zset zset {1 a 2 b 3 c 4 d 5 e}
+ assert_equal 1 [r exists zset]
+ r zremrangebyrank zset $min $max
+ }
+
+ # inner range
+ assert_equal 3 [remrangebyrank 1 3]
+ assert_equal {a e} [r zrange zset 0 -1]
+
+ # start underflow
+ assert_equal 1 [remrangebyrank -10 0]
+ assert_equal {b c d e} [r zrange zset 0 -1]
+
+ # start overflow
+ assert_equal 0 [remrangebyrank 10 -1]
+ assert_equal {a b c d e} [r zrange zset 0 -1]
+
+ # end underflow
+ assert_equal 0 [remrangebyrank 0 -10]
+ assert_equal {a b c d e} [r zrange zset 0 -1]
+
+ # end overflow
+ assert_equal 5 [remrangebyrank 0 10]
+ assert_equal {} [r zrange zset 0 -1]
+
+ # destroy when empty
+ assert_equal 5 [remrangebyrank 0 4]
+ assert_equal 0 [r exists zset]
+ }
+
+ test "ZUNIONSTORE against non-existing key doesn't set destination - $encoding" {
+ r del zseta
+ assert_equal 0 [r zunionstore dst_key 1 zseta]
+ assert_equal 0 [r exists dst_key]
+ }
+
+ test "ZUNIONSTORE with empty set - $encoding" {
+ r del zseta zsetb
+ r zadd zseta 1 a
+ r zadd zseta 2 b
+ r zunionstore zsetc 2 zseta zsetb
+ r zrange zsetc 0 -1 withscores
+ } {a 1 b 2}
+
+ test "ZUNIONSTORE basics - $encoding" {
+ r del zseta zsetb zsetc
+ r zadd zseta 1 a
+ r zadd zseta 2 b
+ r zadd zseta 3 c
+ r zadd zsetb 1 b
+ r zadd zsetb 2 c
+ r zadd zsetb 3 d
+
+ assert_equal 4 [r zunionstore zsetc 2 zseta zsetb]
+ assert_equal {a 1 b 3 d 3 c 5} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZUNIONSTORE with weights - $encoding" {
+ assert_equal 4 [r zunionstore zsetc 2 zseta zsetb weights 2 3]
+ assert_equal {a 2 b 7 d 9 c 12} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZUNIONSTORE with a regular set and weights - $encoding" {
+ r del seta
+ r sadd seta a
+ r sadd seta b
+ r sadd seta c
+
+ assert_equal 4 [r zunionstore zsetc 2 seta zsetb weights 2 3]
+ assert_equal {a 2 b 5 c 8 d 9} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZUNIONSTORE with AGGREGATE MIN - $encoding" {
+ assert_equal 4 [r zunionstore zsetc 2 zseta zsetb aggregate min]
+ assert_equal {a 1 b 1 c 2 d 3} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZUNIONSTORE with AGGREGATE MAX - $encoding" {
+ assert_equal 4 [r zunionstore zsetc 2 zseta zsetb aggregate max]
+ assert_equal {a 1 b 2 c 3 d 3} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZINTERSTORE basics - $encoding" {
+ assert_equal 2 [r zinterstore zsetc 2 zseta zsetb]
+ assert_equal {b 3 c 5} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZINTERSTORE with weights - $encoding" {
+ assert_equal 2 [r zinterstore zsetc 2 zseta zsetb weights 2 3]
+ assert_equal {b 7 c 12} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZINTERSTORE with a regular set and weights - $encoding" {
+ r del seta
+ r sadd seta a
+ r sadd seta b
+ r sadd seta c
+ assert_equal 2 [r zinterstore zsetc 2 seta zsetb weights 2 3]
+ assert_equal {b 5 c 8} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZINTERSTORE with AGGREGATE MIN - $encoding" {
+ assert_equal 2 [r zinterstore zsetc 2 zseta zsetb aggregate min]
+ assert_equal {b 1 c 2} [r zrange zsetc 0 -1 withscores]
+ }
+
+ test "ZINTERSTORE with AGGREGATE MAX - $encoding" {
+ assert_equal 2 [r zinterstore zsetc 2 zseta zsetb aggregate max]
+ assert_equal {b 2 c 3} [r zrange zsetc 0 -1 withscores]
+ }
+
+ foreach cmd {ZUNIONSTORE ZINTERSTORE} {
+ test "$cmd with +inf/-inf scores - $encoding" {
+ r del zsetinf1 zsetinf2
+
+ r zadd zsetinf1 +inf key
+ r zadd zsetinf2 +inf key
+ r $cmd zsetinf3 2 zsetinf1 zsetinf2
+ assert_equal inf [r zscore zsetinf3 key]
+
+ r zadd zsetinf1 -inf key
+ r zadd zsetinf2 +inf key
+ r $cmd zsetinf3 2 zsetinf1 zsetinf2
+ assert_equal 0 [r zscore zsetinf3 key]
+
+ r zadd zsetinf1 +inf key
+ r zadd zsetinf2 -inf key
+ r $cmd zsetinf3 2 zsetinf1 zsetinf2
+ assert_equal 0 [r zscore zsetinf3 key]
+
+ r zadd zsetinf1 -inf key
+ r zadd zsetinf2 -inf key
+ r $cmd zsetinf3 2 zsetinf1 zsetinf2
+ assert_equal -inf [r zscore zsetinf3 key]
+ }
+
+ test "$cmd with NaN weights $encoding" {
+ r del zsetinf1 zsetinf2
+
+ r zadd zsetinf1 1.0 key
+ r zadd zsetinf2 1.0 key
+ assert_error "*weight*not*float*" {
+ r $cmd zsetinf3 2 zsetinf1 zsetinf2 weights nan nan
+ }
+ }
+ }
+ }
+
+ basics ziplist
+ basics skiplist
+
+ test {ZINTERSTORE regression with two sets, intset+hashtable} {
+ r del seta setb setc
+ r sadd set1 a
+ r sadd set2 10
+ r zinterstore set3 2 set1 set2
+ } {0}
+
+ test {ZUNIONSTORE regression, should not create NaN in scores} {
+ r zadd z -inf neginf
+ r zunionstore out 1 z weights 0
+ r zrange out 0 -1 withscores
+ } {neginf 0}
+
+ test {ZINTERSTORE #516 regression, mixed sets and ziplist zsets} {
+ r sadd one 100 101 102 103
+ r sadd two 100 200 201 202
+ r zadd three 1 500 1 501 1 502 1 503 1 100
+ r zinterstore to_here 3 one two three WEIGHTS 0 0 1
+ r zrange to_here 0 -1
+ } {100}
+
+ test {ZUNIONSTORE result is sorted} {
+ # Create two sets with common and not common elements, perform
+ # the UNION, check that elements are still sorted.
+ r del one two dest
+ set cmd1 [list r zadd one]
+ set cmd2 [list r zadd two]
+ for {set j 0} {$j < 1000} {incr j} {
+ lappend cmd1 [expr rand()] [randomInt 1000]
+ lappend cmd2 [expr rand()] [randomInt 1000]
+ }
+ {*}$cmd1
+ {*}$cmd2
+ assert {[r zcard one] > 100}
+ assert {[r zcard two] > 100}
+ r zunionstore dest 2 one two
+ set oldscore 0
+ foreach {ele score} [r zrange dest 0 -1 withscores] {
+ assert {$score >= $oldscore}
+ set oldscore $score
+ }
+ }
+
+ proc stressers {encoding} {
+ if {$encoding == "ziplist"} {
+ # Little extra to allow proper fuzzing in the sorting stresser
+ r config set zset-max-ziplist-entries 256
+ r config set zset-max-ziplist-value 64
+ set elements 128
+ } elseif {$encoding == "skiplist"} {
+ r config set zset-max-ziplist-entries 0
+ r config set zset-max-ziplist-value 0
+ if {$::accurate} {set elements 1000} else {set elements 100}
+ } else {
+ puts "Unknown sorted set encoding"
+ exit
+ }
+
+ test "ZSCORE - $encoding" {
+ r del zscoretest
+ set aux {}
+ for {set i 0} {$i < $elements} {incr i} {
+ set score [expr rand()]
+ lappend aux $score
+ r zadd zscoretest $score $i
+ }
+
+ assert_encoding $encoding zscoretest
+ for {set i 0} {$i < $elements} {incr i} {
+ assert_equal [lindex $aux $i] [r zscore zscoretest $i]
+ }
+ }
+
+ test "ZSCORE after a DEBUG RELOAD - $encoding" {
+ r del zscoretest
+ set aux {}
+ for {set i 0} {$i < $elements} {incr i} {
+ set score [expr rand()]
+ lappend aux $score
+ r zadd zscoretest $score $i
+ }
+
+ r debug reload
+ assert_encoding $encoding zscoretest
+ for {set i 0} {$i < $elements} {incr i} {
+ assert_equal [lindex $aux $i] [r zscore zscoretest $i]
+ }
+ }
+
+ test "ZSET sorting stresser - $encoding" {
+ set delta 0
+ for {set test 0} {$test < 2} {incr test} {
+ unset -nocomplain auxarray
+ array set auxarray {}
+ set auxlist {}
+ r del myzset
+ for {set i 0} {$i < $elements} {incr i} {
+ if {$test == 0} {
+ set score [expr rand()]
+ } else {
+ set score [expr int(rand()*10)]
+ }
+ set auxarray($i) $score
+ r zadd myzset $score $i
+ # Random update
+ if {[expr rand()] < .2} {
+ set j [expr int(rand()*1000)]
+ if {$test == 0} {
+ set score [expr rand()]
+ } else {
+ set score [expr int(rand()*10)]
+ }
+ set auxarray($j) $score
+ r zadd myzset $score $j
+ }
+ }
+ foreach {item score} [array get auxarray] {
+ lappend auxlist [list $score $item]
+ }
+ set sorted [lsort -command zlistAlikeSort $auxlist]
+ set auxlist {}
+ foreach x $sorted {
+ lappend auxlist [lindex $x 1]
+ }
+
+ assert_encoding $encoding myzset
+ set fromredis [r zrange myzset 0 -1]
+ set delta 0
+ for {set i 0} {$i < [llength $fromredis]} {incr i} {
+ if {[lindex $fromredis $i] != [lindex $auxlist $i]} {
+ incr delta
+ }
+ }
+ }
+ assert_equal 0 $delta
+ }
+
+ test "ZRANGEBYSCORE fuzzy test, 100 ranges in $elements element sorted set - $encoding" {
+ set err {}
+ r del zset
+ for {set i 0} {$i < $elements} {incr i} {
+ r zadd zset [expr rand()] $i
+ }
+
+ assert_encoding $encoding zset
+ for {set i 0} {$i < 100} {incr i} {
+ set min [expr rand()]
+ set max [expr rand()]
+ if {$min > $max} {
+ set aux $min
+ set min $max
+ set max $aux
+ }
+ set low [r zrangebyscore zset -inf $min]
+ set ok [r zrangebyscore zset $min $max]
+ set high [r zrangebyscore zset $max +inf]
+ set lowx [r zrangebyscore zset -inf ($min]
+ set okx [r zrangebyscore zset ($min ($max]
+ set highx [r zrangebyscore zset ($max +inf]
+
+ if {[r zcount zset -inf $min] != [llength $low]} {
+ append err "Error, len does not match zcount\n"
+ }
+ if {[r zcount zset $min $max] != [llength $ok]} {
+ append err "Error, len does not match zcount\n"
+ }
+ if {[r zcount zset $max +inf] != [llength $high]} {
+ append err "Error, len does not match zcount\n"
+ }
+ if {[r zcount zset -inf ($min] != [llength $lowx]} {
+ append err "Error, len does not match zcount\n"
+ }
+ if {[r zcount zset ($min ($max] != [llength $okx]} {
+ append err "Error, len does not match zcount\n"
+ }
+ if {[r zcount zset ($max +inf] != [llength $highx]} {
+ append err "Error, len does not match zcount\n"
+ }
+
+ foreach x $low {
+ set score [r zscore zset $x]
+ if {$score > $min} {
+ append err "Error, score for $x is $score > $min\n"
+ }
+ }
+ foreach x $lowx {
+ set score [r zscore zset $x]
+ if {$score >= $min} {
+ append err "Error, score for $x is $score >= $min\n"
+ }
+ }
+ foreach x $ok {
+ set score [r zscore zset $x]
+ if {$score < $min || $score > $max} {
+ append err "Error, score for $x is $score outside $min-$max range\n"
+ }
+ }
+ foreach x $okx {
+ set score [r zscore zset $x]
+ if {$score <= $min || $score >= $max} {
+ append err "Error, score for $x is $score outside $min-$max open range\n"
+ }
+ }
+ foreach x $high {
+ set score [r zscore zset $x]
+ if {$score < $max} {
+ append err "Error, score for $x is $score < $max\n"
+ }
+ }
+ foreach x $highx {
+ set score [r zscore zset $x]
+ if {$score <= $max} {
+ append err "Error, score for $x is $score <= $max\n"
+ }
+ }
+ }
+ assert_equal {} $err
+ }
+
+ test "ZRANGEBYLEX fuzzy test, 100 ranges in $elements element sorted set - $encoding" {
+ set lexset {}
+ r del zset
+ for {set j 0} {$j < $elements} {incr j} {
+ set e [randstring 0 30 alpha]
+ lappend lexset $e
+ r zadd zset 0 $e
+ }
+ set lexset [lsort -unique $lexset]
+ for {set j 0} {$j < 100} {incr j} {
+ set min [randstring 0 30 alpha]
+ set max [randstring 0 30 alpha]
+ set mininc [randomInt 2]
+ set maxinc [randomInt 2]
+ if {$mininc} {set cmin "\[$min"} else {set cmin "($min"}
+ if {$maxinc} {set cmax "\[$max"} else {set cmax "($max"}
+ set rev [randomInt 2]
+ if {$rev} {
+ set cmd zrevrangebylex
+ } else {
+ set cmd zrangebylex
+ }
+
+ # Make sure data is the same in both sides
+ assert {[r zrange zset 0 -1] eq $lexset}
+
+ # Get the Redis output
+ set output [r $cmd zset $cmin $cmax]
+ if {$rev} {
+ set outlen [r zlexcount zset $cmax $cmin]
+ } else {
+ set outlen [r zlexcount zset $cmin $cmax]
+ }
+
+ # Compute the same output via Tcl
+ set o {}
+ set copy $lexset
+ if {(!$rev && [string compare $min $max] > 0) ||
+ ($rev && [string compare $max $min] > 0)} {
+ # Empty output when ranges are inverted.
+ } else {
+ if {$rev} {
+ # Invert the Tcl array using Redis itself.
+ set copy [r zrevrange zset 0 -1]
+ # Invert min / max as well
+ lassign [list $min $max $mininc $maxinc] \
+ max min maxinc mininc
+ }
+ foreach e $copy {
+ set mincmp [string compare $e $min]
+ set maxcmp [string compare $e $max]
+ if {
+ ($mininc && $mincmp >= 0 || !$mininc && $mincmp > 0)
+ &&
+ ($maxinc && $maxcmp <= 0 || !$maxinc && $maxcmp < 0)
+ } {
+ lappend o $e
+ }
+ }
+ }
+ assert {$o eq $output}
+ assert {$outlen eq [llength $output]}
+ }
+ }
+
+ test "ZREMRANGEBYLEX fuzzy test, 100 ranges in $elements element sorted set - $encoding" {
+ set lexset {}
+ r del zset zsetcopy
+ for {set j 0} {$j < $elements} {incr j} {
+ set e [randstring 0 30 alpha]
+ lappend lexset $e
+ r zadd zset 0 $e
+ }
+ set lexset [lsort -unique $lexset]
+ for {set j 0} {$j < 100} {incr j} {
+ # Copy...
+ r zunionstore zsetcopy 1 zset
+ set lexsetcopy $lexset
+
+ set min [randstring 0 30 alpha]
+ set max [randstring 0 30 alpha]
+ set mininc [randomInt 2]
+ set maxinc [randomInt 2]
+ if {$mininc} {set cmin "\[$min"} else {set cmin "($min"}
+ if {$maxinc} {set cmax "\[$max"} else {set cmax "($max"}
+
+ # Make sure data is the same in both sides
+ assert {[r zrange zset 0 -1] eq $lexset}
+
+ # Get the range we are going to remove
+ set torem [r zrangebylex zset $cmin $cmax]
+ set toremlen [r zlexcount zset $cmin $cmax]
+ r zremrangebylex zsetcopy $cmin $cmax
+ set output [r zrange zsetcopy 0 -1]
+
+ # Remove the range with Tcl from the original list
+ if {$toremlen} {
+ set first [lsearch -exact $lexsetcopy [lindex $torem 0]]
+ set last [expr {$first+$toremlen-1}]
+ set lexsetcopy [lreplace $lexsetcopy $first $last]
+ }
+ assert {$lexsetcopy eq $output}
+ }
+ }
+
+ test "ZSETs skiplist implementation backlink consistency test - $encoding" {
+ set diff 0
+ for {set j 0} {$j < $elements} {incr j} {
+ r zadd myzset [expr rand()] "Element-$j"
+ r zrem myzset "Element-[expr int(rand()*$elements)]"
+ }
+
+ assert_encoding $encoding myzset
+ set l1 [r zrange myzset 0 -1]
+ set l2 [r zrevrange myzset 0 -1]
+ for {set j 0} {$j < [llength $l1]} {incr j} {
+ if {[lindex $l1 $j] ne [lindex $l2 end-$j]} {
+ incr diff
+ }
+ }
+ assert_equal 0 $diff
+ }
+
+ test "ZSETs ZRANK augmented skip list stress testing - $encoding" {
+ set err {}
+ r del myzset
+ for {set k 0} {$k < 2000} {incr k} {
+ set i [expr {$k % $elements}]
+ if {[expr rand()] < .2} {
+ r zrem myzset $i
+ } else {
+ set score [expr rand()]
+ r zadd myzset $score $i
+ assert_encoding $encoding myzset
+ }
+
+ set card [r zcard myzset]
+ if {$card > 0} {
+ set index [randomInt $card]
+ set ele [lindex [r zrange myzset $index $index] 0]
+ set rank [r zrank myzset $ele]
+ if {$rank != $index} {
+ set err "$ele RANK is wrong! ($rank != $index)"
+ break
+ }
+ }
+ }
+ assert_equal {} $err
+ }
+ }
+
+ tags {"slow"} {
+ stressers ziplist
+ stressers skiplist
+ }
+}
diff --git a/tests/unit/wait.tcl b/tests/unit/wait.tcl
new file mode 100644
index 0000000..e2f5d29
--- /dev/null
+++ b/tests/unit/wait.tcl
@@ -0,0 +1,42 @@
+start_server {tags {"wait"}} {
+start_server {} {
+ set slave [srv 0 client]
+ set slave_host [srv 0 host]
+ set slave_port [srv 0 port]
+ set master [srv -1 client]
+ set master_host [srv -1 host]
+ set master_port [srv -1 port]
+
+ test {Setup slave} {
+ $slave slaveof $master_host $master_port
+ wait_for_condition 50 100 {
+ [s 0 master_link_status] eq {up}
+ } else {
+ fail "Replication not started."
+ }
+ }
+
+ test {WAIT should acknowledge 1 additional copy of the data} {
+ $master set foo 0
+ $master incr foo
+ $master incr foo
+ $master incr foo
+ assert {[$master wait 1 5000] == 1}
+ assert {[$slave get foo] == 3}
+ }
+
+ test {WAIT should not acknowledge 2 additional copies of the data} {
+ $master incr foo
+ assert {[$master wait 2 1000] <= 1}
+ }
+
+ test {WAIT should not acknowledge 1 additional copy if slave is blocked} {
+ exec src/redis-cli -h $slave_host -p $slave_port debug sleep 5 > /dev/null 2> /dev/null &
+ after 1000 ;# Give redis-cli the time to execute the command.
+ $master set foo 0
+ $master incr foo
+ $master incr foo
+ $master incr foo
+ assert {[$master wait 1 3000] == 0}
+ }
+}}