X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/7c49733ce3f550a96f60a9213911fdc9265cedc8..4d16bb253c8807e45abcd776fcf6521c525a3f2b:/test-redis.tcl diff --git a/test-redis.tcl b/test-redis.tcl index 8568a60d..3b5900f9 100644 --- a/test-redis.tcl +++ b/test-redis.tcl @@ -23,6 +23,12 @@ proc test {name code okpattern} { puts "!! ERROR expected\n'$okpattern'\nbut got\n'$retval'" incr ::failed } + if {$::traceleaks} { + if {![string match {*0 leaks*} [exec leaks redis-server]]} { + puts "--------- Test $::testnum LEAKED! --------" + exit 1 + } + } } proc randstring {min max {type binary}} { @@ -65,15 +71,138 @@ proc waitForBgsave r { } } -proc main {server port} { - set r [redis $server $port] +proc waitForBgrewriteaof r { + while 1 { + set i [$r info] + if {[string match {*bgrewriteaof_in_progress:1*} $i]} { + puts -nonewline "\nWaiting for background AOF rewrite to finish... " + flush stdout + after 1000 + } else { + break + } + } +} + +proc randomInt {max} { + expr {int(rand()*$max)} +} + +proc randpath args { + set path [expr {int(rand()*[llength $args])}] + uplevel 1 [lindex $args $path] +} + +proc randomValue {} { + randpath { + # Small enough to likely collide + randomInt 1000 + } { + # 32 bit compressible signed/unsigned + randpath {randomInt 2000000000} {randomInt 4000000000} + } { + # 64 bit + randpath {randomInt 1000000000000} + } { + # Random string + randpath {randstring 0 256 alpha} \ + {randstring 0 256 compr} \ + {randstring 0 256 binary} + } +} + +proc randomKey {} { + randpath { + # Small enough to likely collide + randomInt 1000 + } { + # 32 bit compressible signed/unsigned + randpath {randomInt 2000000000} {randomInt 4000000000} + } { + # 64 bit + randpath {randomInt 1000000000000} + } { + # Random string + randpath {randstring 1 256 alpha} \ + {randstring 1 256 compr} + } +} + +proc createComplexDataset {r ops} { + for {set j 0} {$j < $ops} {incr j} { + set k [randomKey] + set f [randomValue] + set v [randomValue] + randpath { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + set d [expr {rand()}] + } { + randpath {set d +inf} {set d -inf} + } + set t [$r type $k] + + if {$t eq {none}} { + randpath { + $r set $k $v + } { + $r lpush $k $v + } { + $r sadd $k $v + } { + $r zadd $k $d $v + } { + $r hset $k $f $v + } + set t [$r type $k] + } + + switch $t { + {string} { + # Nothing to do + } + {list} { + randpath {$r lpush $k $v} \ + {$r rpush $k $v} \ + {$r lrem $k 0 $v} \ + {$r rpop $k} \ + {$r lpop $k} + } + {set} { + randpath {$r sadd $k $v} \ + {$r srem $k $v} + } + {zset} { + randpath {$r zadd $k $d $v} \ + {$r zrem $k $v} + } + {hash} { + randpath {$r hset $k $f $v} \ + {$r hdel $k $f} + } + } + } +} + +proc datasetDigest r { + $r debug digest +} + +proc main {} { + set r [redis $::host $::port] $r select 9 set err "" set res "" # The following AUTH test should be enabled only when requirepass # is set in redis.conf and redis-server was started with - # redis.conf as the first argument. + # redis.conf as the first argument. #test {AUTH with requirepass in redis.conf} { # $r auth foobared @@ -132,20 +261,46 @@ proc main {server port} { $r get foo } [string repeat "abcd" 1000000] + 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} { + 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} { - incr sum [$r get $x] + set val [$r get $x] + if {$val ne $x} { + set err "Eleemnt at position $x is $val instead of $x" + break + } } - format $sum - } {49995000} + set _ $err + } {} - test {DBSIZE should be 10001 now} { + test {DBSIZE should be 10101 now} { $r dbsize - } {10001} + } {10101} test {INCR against non existing key} { set res {} @@ -172,6 +327,19 @@ proc main {server port} { $r incrby novar 17179869184 } {34359738368} + test {INCR fails against key with spaces (no integer encoded)} { + $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 + } {ERR*} + test {DECRBY over 32bit value with over 32bit increment, negative res} { $r set novar 17179869184 $r decrby novar 17179869185 @@ -227,14 +395,20 @@ proc main {server port} { } {1} test {Basic LPUSH, RPUSH, LLENGTH, LINDEX} { - $r lpush mylist a - $r lpush mylist b - $r rpush mylist c - set res [$r llen mylist] + set res [$r lpush mylist a] + append res [$r lpush mylist b] + append res [$r rpush mylist c] + append res [$r llen mylist] + append res [$r rpush anotherlist d] + append res [$r lpush anotherlist e] + append res [$r llen anotherlist] append res [$r lindex mylist 0] append res [$r lindex mylist 1] append res [$r lindex mylist 2] - } {3bac} + append res [$r lindex anotherlist 0] + append res [$r lindex anotherlist 1] + list $res [$r lindex mylist 100] + } {1233122baced {}} test {DEL a list} { $r del mylist @@ -287,11 +461,19 @@ proc main {server port} { format $err } {ERR*} + test {LLEN against non existing key} { + $r llen not-a-key + } {0} + test {LINDEX against non-list value error} { catch {$r lindex mylist 0} err format $err } {ERR*} + test {LINDEX against non existing key} { + $r lindex not-a-key 10 + } {} + test {LPUSH against non-list value error} { catch {$r lpush mylist 0} err format $err @@ -368,6 +550,12 @@ proc main {server port} { list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2] } {{a b c d} string ERR} + test {RPOPLPUSH against non existing src key} { + $r del mylist + $r del newlist + $r rpoplpush mylist newlist + } {} + test {RENAME basic usage} { $r set mykey hello $r rename mykey mykey1 @@ -531,7 +719,36 @@ proc main {server port} { $r lrange mylist 0 -1 } {99 98 97 96 95} + test {LTRIM stress testing} { + set mylist {} + set err {} + for {set i 0} {$i < 20} {incr i} { + lappend mylist $i + } + + for {set j 0} {$j < 100} {incr j} { + # Fill the list + $r del mylist + for {set i 0} {$i < 20} {incr i} { + $r rpush mylist $i + } + # Trim at random + set a [randomInt 20] + set b [randomInt 20] + $r ltrim mylist $a $b + if {[$r lrange mylist 0 -1] ne [lrange $mylist $a $b]} { + set err "[$r lrange mylist 0 -1] != [lrange $mylist $a $b]" + break + } + } + set _ $err + } {} + test {LSET} { + $r del mylist + foreach x {99 98 97 96 95} { + $r rpush mylist $x + } $r lset mylist 1 foo $r lset mylist -1 bar $r lrange mylist 0 -1 @@ -590,7 +807,7 @@ proc main {server port} { test {SUNION with two sets} { lsort [$r sunion set1 set2] } [lsort -uniq "[$r smembers set1] [$r smembers set2]"] - + test {SINTERSTORE with two sets} { $r sinterstore setres set1 set2 lsort [$r smembers setres] @@ -661,9 +878,9 @@ proc main {server port} { $r lpush mysavelist world $r set myemptykey {} $r set mynormalkey {blablablba} - $r zadd mytestzset a 10 - $r zadd mytestzset b 20 - $r zadd mytestzset c 30 + $r zadd mytestzset 10 a + $r zadd mytestzset 20 b + $r zadd mytestzset 30 c $r save } {OK} @@ -679,20 +896,35 @@ proc main {server port} { } lsort [array names myset] } {a b c} - - test {Create a random list} { + + 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 {Create a random list and a random set} { set tosort {} array set seenrand {} for {set i 0} {$i < 10000} {incr i} { while 1 { # Make sure all the weights are different because # Redis does not use a stable sort but Tcl does. - set rint [expr int(rand()*1000000)] + randpath { + set rint [expr int(rand()*1000000)] + } { + set rint [expr rand()] + } if {![info exists seenrand($rint)]} break } set seenrand($rint) x $r lpush tosort $i + $r sadd tosort-set $i $r set weight_$i $rint + $r hset wobj_$i weight $rint lappend tosort [list $i $rint] } set sorted [lsort -index 1 -real $tosort] @@ -707,6 +939,46 @@ proc main {server port} { $r sort tosort {BY weight_*} } $res + test {SORT with BY (hash field) against the newly created list} { + $r sort tosort {BY wobj_*->weight} + } $res + + test {SORT with GET (key+hash) with sanity check of each element (list)} { + set err {} + set l1 [$r sort tosort GET # GET weight_*] + set l2 [$r sort tosort GET # GET wobj_*->weight] + foreach {id1 w1} $l1 {id2 w2} $l2 { + set realweight [$r get weight_$id1] + if {$id1 != $id2} { + set err "ID mismatch $id1 != $id2" + break + } + if {$realweight != $w1 || $realweight != $w2} { + set err "Weights mismatch! w1: $w1 w2: $w2 real: $realweight" + break + } + } + set _ $err + } {} + + test {SORT with BY, but against the newly created set} { + $r sort tosort-set {BY weight_*} + } $res + + test {SORT with BY (hash field), but against the newly created set} { + $r sort tosort-set {BY wobj_*->weight} + } $res + + test {SORT with BY and STORE against the newly created list} { + $r sort tosort {BY weight_*} store sort-res + $r lrange sort-res 0 -1 + } $res + + test {SORT with BY (hash field) and STORE against the newly created list} { + $r sort tosort {BY wobj_*->weight} store sort-res + $r lrange sort-res 0 -1 + } $res + test {SORT direct, numeric, against the newly created list} { $r sort tosort } [lsort -integer $res] @@ -726,6 +998,17 @@ proc main {server port} { format {} } {} + test {SORT speed, as above but against hash field} { + 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] + puts -nonewline "\n Average time to sort: [expr double($elapsed)/100] milliseconds " + flush stdout + format {} + } {} + test {SORT speed, sorting 10000 elements list directly, 100 times} { set start [clock clicks -milliseconds] for {set i 0} {$i < 100} {incr i} { @@ -765,6 +1048,10 @@ proc main {server port} { $r sort mylist BY weight_* GET # } {2 1 3} + test {SORT with constant GET} { + $r sort mylist GET foo + } {{} {} {}} + test {LREM, remove all the occurrences} { $r flushdb $r rpush mylist foo @@ -951,6 +1238,22 @@ proc main {server port} { $r zcard ztmp-blabla } {0} + test {ZRANK basics} { + $r zadd zranktmp 10 x + $r zadd zranktmp 20 y + $r zadd zranktmp 30 z + list [$r zrank zranktmp x] [$r zrank zranktmp y] [$r zrank zranktmp z] + } {0 1 2} + + test {ZREVRANK basics} { + list [$r zrevrank zranktmp x] [$r zrevrank zranktmp y] [$r zrevrank zranktmp z] + } {2 1 0} + + test {ZRANK - after deletion} { + $r zrem zranktmp y + list [$r zrank zranktmp x] [$r zrank zranktmp z] + } {0 1} + test {ZSCORE} { set aux {} set err {} @@ -987,9 +1290,14 @@ proc main {server port} { set _ $err } {} - test {ZRANGE and ZREVRANGE} { - list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] - } {{y x z} {z x y}} + test {ZRANGE and ZREVRANGE basics} { + list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] \ + [$r zrange ztmp 1 -1] [$r zrevrange ztmp 1 -1] + } {{y x z} {z x y} {x z} {x y}} + + test {ZRANGE WITHSCORES} { + $r zrange ztmp 0 -1 withscores + } {y 1 x 10 z 30} test {ZSETs stress tester - sorting is working well?} { set delta 0 @@ -1054,15 +1362,26 @@ proc main {server port} { list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar] } {{bar foo} {foo bar} -2 6} - test {ZRANGEBYSCORE basics} { + test {ZRANGEBYSCORE and ZCOUNT basics} { + $r del zset + $r zadd zset 1 a + $r zadd zset 2 b + $r zadd zset 3 c + $r zadd zset 4 d + $r zadd zset 5 e + list [$r zrangebyscore zset 2 4] [$r zrangebyscore zset (2 (4] \ + [$r zcount zset 2 4] [$r zcount zset (2 (4] + } {{b c d} c 3 1} + + test {ZRANGEBYSCORE withscores} { $r del zset $r zadd zset 1 a $r zadd zset 2 b $r zadd zset 3 c $r zadd zset 4 d $r zadd zset 5 e - $r zrangebyscore zset 2 4 - } {b c d} + $r zrangebyscore zset 2 4 withscores + } {b 2 c 3 d 4} test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} { set err {} @@ -1081,24 +1400,65 @@ proc main {server port} { 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" + } + } } set _ $err } {} @@ -1117,7 +1477,17 @@ proc main {server port} { [$r zrangebyscore zset 0 10 LIMIT 20 10] } {{a b} {c d e} {c d e} {}} - test {ZREMRANGE basics} { + test {ZRANGEBYSCORE with LIMIT and withscores} { + $r del zset + $r zadd zset 10 a + $r zadd zset 20 b + $r zadd zset 30 c + $r zadd zset 40 d + $r zadd zset 50 e + $r zrangebyscore zset 20 50 LIMIT 2 3 withscores + } {d 40 e 50} + + test {ZREMRANGEBYSCORE basics} { $r del zset $r zadd zset 1 a $r zadd zset 2 b @@ -1127,7 +1497,7 @@ proc main {server port} { list [$r zremrangebyscore zset 2 4] [$r zrange zset 0 -1] } {3 {a e}} - test {ZREMRANGE from -inf to +inf} { + test {ZREMRANGEBYSCORE from -inf to +inf} { $r del zset $r zadd zset 1 a $r zadd zset 2 b @@ -1137,6 +1507,60 @@ proc main {server port} { list [$r zremrangebyscore zset -inf +inf] [$r zrange zset 0 -1] } {5 {}} + test {ZREMRANGEBYRANK basics} { + $r del zset + $r zadd zset 1 a + $r zadd zset 2 b + $r zadd zset 3 c + $r zadd zset 4 d + $r zadd zset 5 e + list [$r zremrangebyrank zset 1 3] [$r zrange zset 0 -1] + } {3 {a e}} + + test {ZUNION against non-existing key doesn't set destination} { + $r del zseta + list [$r zunion dst_key 1 zseta] [$r exists dst_key] + } {0 0} + + test {ZUNION basics} { + $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 + list [$r zunion zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores] + } {4 {a 1 b 3 d 3 c 5}} + + test {ZUNION with weights} { + list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores] + } {4 {a 2 b 7 d 9 c 12}} + + test {ZUNION with AGGREGATE MIN} { + list [$r zunion zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores] + } {4 {a 1 b 1 c 2 d 3}} + + test {ZUNION with AGGREGATE MAX} { + list [$r zunion zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores] + } {4 {a 1 b 2 c 3 d 3}} + + test {ZINTER basics} { + list [$r zinter zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores] + } {2 {b 3 c 5}} + + test {ZINTER with weights} { + list [$r zinter zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores] + } {2 {b 7 c 12}} + + test {ZINTER with AGGREGATE MIN} { + list [$r zinter zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores] + } {2 {b 1 c 2}} + + test {ZINTER with AGGREGATE MAX} { + list [$r zinter zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores] + } {2 {b 2 c 3}} + test {SORT against sorted sets} { $r del zset $r zadd zset 1 a @@ -1158,6 +1582,298 @@ proc main {server port} { $r zrange zset 0 -1 } {min c a b d max} + test {HSET/HLEN - Small hash creation} { + array set smallhash {} + for {set i 0} {$i < 8} {incr i} { + set key [randstring 0 8 alpha] + set val [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 zipmap?} { + $r debug object smallhash + } {*zipmap*} + + test {HSET/HLEN - Big hash creation} { + array set bighash {} + for {set i 0} {$i < 1024} {incr i} { + set key [randstring 0 8 alpha] + set val [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 a zipmap?} { + $r debug object bighash + } {*hashtable*} + + 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 - 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 {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 zipmap 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} { + $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} + + # TODO: + # Randomized test, small and big + # .rdb / AOF consistency test should include hashes + test {EXPIRE - don't set timeouts multiple times} { $r set x foobar set v1 [$r expire x 5] @@ -1191,6 +1907,30 @@ proc main {server port} { $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} + + test {SETEX - Wait for the key to expire} { + after 3000 + $r get y + } {} + + test {SETEX - Wrong time parameter} { + catch {$r setex z -10 foo} e + set _ $e + } {*invalid expire*} + test {ZSETs skiplist implementation backlink consistency test} { set diff 0 set elements 10000 @@ -1208,6 +1948,31 @@ proc main {server port} { format $diff } {0} + test {ZSETs ZRANK augmented skip list stress testing} { + set err {} + $r del myzset + for {set k 0} {$k < 10000} {incr k} { + set i [expr {$k%1000}] + if {[expr rand()] < .2} { + $r zrem myzset $i + } else { + set score [expr rand()] + $r zadd myzset $score $i + } + 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 + } + } + } + set _ $err + } {} + foreach fuzztype {binary alpha compr} { test "FUZZ stresser with data model $fuzztype" { set err 0 @@ -1225,6 +1990,7 @@ proc main {server port} { } test {BGSAVE} { + waitForBgsave $r $r flushdb $r save $r set x 10 @@ -1279,6 +2045,163 @@ proc main {server port} { set _ $err } {*invalid*} + if {![catch {package require sha1}]} { + test {Check consistency of different data types after a reload} { + $r flushdb + createComplexDataset $r 10000 + set sha1 [datasetDigest $r] + $r debug reload + set sha1_after [datasetDigest $r] + expr {$sha1 eq $sha1_after} + } {1} + + test {Same dataset digest if saving/reloading as AOF?} { + $r bgrewriteaof + waitForBgrewriteaof $r + $r debug loadaof + set sha1_after [datasetDigest $r] + expr {$sha1 eq $sha1_after} + } {1} + } + + test {EXPIRES after a reload (snapshot + append only file)} { + $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 + set ttl [$r ttl x] + set e2 [expr {$ttl > 900 && $ttl <= 1000}] + list $e1 $e2 + } {1 1} + + 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 [string length $val]\r\n$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 {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 {APPEND basics} { + 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 + } {} + + test {SUBSTR basics} { + set res {} + $r set foo "Hello World" + lappend res [$r substr foo 0 3] + lappend res [$r substr foo 0 -1] + lappend res [$r substr foo -4 -1] + lappend res [$r substr foo 5 3] + lappend res [$r substr foo 5 5000] + lappend res [$r substr foo -5000 10000] + set _ $res + } {Hell {Hello World} orld {} { World} {Hello World}} + + test {SUBSTR against integer encoded values} { + $r set foo 123 + $r substr foo 0 -2 + } {12} + + test {SUBSTR fuzzing} { + set err {} + for {set i 0} {$i < 1000} {incr i} { + 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]"} + set s1 [string range $bin $_start $_end] + $r set bin $bin + set s2 [$r substr bin $start $end] + if {$s1 != $s2} { + set err "String mismatch" + break + } + } + set _ $err + } {} + # Leave the user with a clean DB before to exit test {FLUSHDB} { set aux {} @@ -1309,7 +2232,7 @@ proc main {server port} { } proc stress {} { - set r [redis] + set r [redis $::host $::port] $r select 9 $r flushdb while 1 { @@ -1346,6 +2269,7 @@ proc stress {} { set ::host 127.0.0.1 set ::port 6379 set ::stress 0 +set ::traceleaks 0 set ::flush 0 set ::first 0 set ::last 1000000 @@ -1361,8 +2285,10 @@ for {set j 0} {$j < [llength $argv]} {incr j} { } elseif {$opt eq {-p} && !$lastarg} { set ::port $arg incr j - } elseif {$opt eq {-stress}} { + } elseif {$opt eq {--stress}} { set ::stress 1 + } elseif {$opt eq {--trace-leaks}} { + set ::traceleaks 1 } elseif {$opt eq {--flush}} { set ::flush 1 } elseif {$opt eq {--first} && !$lastarg} { @@ -1378,7 +2304,7 @@ for {set j 0} {$j < [llength $argv]} {incr j} { } # Before to run the test check if DB 9 and DB 10 are empty -set r [redis] +set r [redis $::host $::port] if {$::flush} { $r flushall @@ -1397,8 +2323,9 @@ unset r unset db9size unset db10size +puts "Testing Redis, host $::host, port $::port" if {$::stress} { stress } else { - main $::host $::port + main }