diff options
| author | byte2016 <[email protected]> | 2018-06-12 19:55:38 +0800 |
|---|---|---|
| committer | byte2016 <[email protected]> | 2018-06-12 19:55:38 +0800 |
| commit | 76f2c13d7c27d7419af79ea0bdc7ab7717b6935b (patch) | |
| tree | aa2ca741501d40990b892d504a1cc3b7defe57aa /tests/unit | |
Diffstat (limited to 'tests/unit')
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} + } +}} |
