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}} {
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()}]
$r sadd $k $v
} {
$r zadd $k $d $v
+ } {
+ $r hset $k $f $v
}
set t [$r type $k]
}
randpath {$r zadd $k $d $v} \
{$r zrem $k $v}
}
+ {hash} {
+ randpath {$r hset $k $f $v} \
+ {$r hdel $k $f}
+ }
}
}
}
proc datasetDigest r {
- set keys [lsort [split [$r keys *] " "]]
+ set keys [lsort [$r keys *]]
set digest {}
foreach k $keys {
set t [$r type $k]
if {[$r zcard $k] == 0} {
set aux {}
} else {
- set aux [::sha1::sha1 -hex [$r zrange $k 0 -1]]
+ set aux [::sha1::sha1 -hex [$r zrange $k 0 -1 withscores]]
+ }
+ } {hash} {
+ if {[$r hlen $k] == 0} {
+ set aux {}
+ } else {
+ set aux [::sha1::sha1 -hex [lsort [$r hgetall $k]]]
}
} default {
- error "Type not supported"
+ error "Type not supported: $t"
}
}
if {$aux eq {}} continue
return $digest
}
-proc main {server port} {
- set r [redis $server $port]
+proc main {} {
+ set r [redis $::host $::port]
$r select 9
set err ""
set res ""
# The following AUTH test should be enabled only when requirepass
# <PASSWORD> 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
$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 {}
$r incrby novar 17179869184
} {34359738368}
- test {INCR against key with spaces (no integer encoded)} {
+ test {INCR fails against key with spaces (no integer encoded)} {
$r set novar " 11 "
- $r incr novar
- } {12}
+ 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
} {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]
+ append res [$r lindex anotherlist 0]
+ append res [$r lindex anotherlist 1]
list $res [$r lindex mylist 100]
- } {3bac {}}
+ } {1233122baced {}}
test {DEL a list} {
$r del mylist
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]
$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}
}
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]
$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]
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} {
$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 {}
[$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
for {set test 0} {$test < 2} {incr test} {
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
- $r zrangebyscore zset 2 4
- } {b c d}
+ 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 withscores
+ } {b 2 c 3 d 4}
test {ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set} {
set err {}
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
} {}
[$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
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
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
$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]
$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
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
}
test {BGSAVE} {
+ waitForBgsave $r
$r flushdb
$r save
$r set x 10
} {1 1}
test {PIPELINING stresser (also a regression for the old epoll bug)} {
- set fd2 [socket 127.0.0.1 6379]
+ 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 _ 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 {}
}
proc stress {} {
- set r [redis]
+ set r [redis $::host $::port]
$r select 9
$r flushdb
while 1 {
set ::host 127.0.0.1
set ::port 6379
set ::stress 0
+set ::traceleaks 0
set ::flush 0
set ::first 0
set ::last 1000000
} 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} {
}
# 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
unset db9size
unset db10size
+puts "Testing Redis, host $::host, port $::port"
if {$::stress} {
stress
} else {
- main $::host $::port
+ main
}
projects / redis.git / blobdiff