# TODO # test pipelining
-source client-libraries/tcl/redis.tcl
+set tcl_precision 17
+source redis.tcl
set ::passed 0
set ::failed 0
proc main {server port} {
set r [redis $server $port]
+ $r select 9
set err ""
# The following AUTH test should be enabled only when requirepass
format $ok
} {2000}
+ test {Check if the list is still ok after a DEBUG RELOAD} {
+ $r debug reload
+ set ok 0
+ for {set i 0} {$i < 1000} {incr i} {
+ set rint [expr int(rand()*1000)]
+ if {[$r lindex mylist $rint] eq $rint} {incr ok}
+ if {[$r lindex mylist [expr (-$rint)-1]] eq [expr 999-$rint]} {
+ incr ok
+ }
+ }
+ format $ok
+ } {2000}
+
test {LLEN against non-list value error} {
$r del mylist
$r set mylist foobar
format $err
} {ERR*}
+ test {RPOPLPUSH base case} {
+ $r del mylist
+ $r rpush mylist a
+ $r rpush mylist b
+ $r rpush mylist c
+ $r rpush mylist d
+ set v1 [$r rpoplpush mylist newlist]
+ set v2 [$r rpoplpush mylist newlist]
+ set l1 [$r lrange mylist 0 -1]
+ set l2 [$r lrange newlist 0 -1]
+ list $v1 $v2 $l1 $l2
+ } {d c {a b} {c d}}
+
+ test {RPOPLPUSH with the same list as src and dst} {
+ $r del mylist
+ $r rpush mylist a
+ $r rpush mylist b
+ $r rpush mylist c
+ set l1 [$r lrange mylist 0 -1]
+ set v [$r rpoplpush mylist mylist]
+ set l2 [$r lrange mylist 0 -1]
+ list $l1 $v $l2
+ } {{a b c} c {c a b}}
+
+ test {RPOPLPUSH target list already exists} {
+ $r del mylist
+ $r del newlist
+ $r rpush mylist a
+ $r rpush mylist b
+ $r rpush mylist c
+ $r rpush mylist d
+ $r rpush newlist x
+ set v1 [$r rpoplpush mylist newlist]
+ set v2 [$r rpoplpush mylist newlist]
+ set l1 [$r lrange mylist 0 -1]
+ set l2 [$r lrange newlist 0 -1]
+ list $v1 $v2 $l1 $l2
+ } {d c {a b} {c d x}}
+
+ test {RPOPLPUSH against non existing key} {
+ $r del mylist
+ $r del newlist
+ set v1 [$r rpoplpush mylist newlist]
+ list $v1 [$r exists mylist] [$r exists newlist]
+ } {{} 0 0}
+
+ test {RPOPLPUSH against non list src key} {
+ $r del mylist
+ $r del newlist
+ $r set mylist x
+ catch {$r rpoplpush mylist newlist} err
+ list [$r type mylist] [$r exists newlist] [string range $err 0 2]
+ } {string 0 ERR}
+
+ test {RPOPLPUSH against non list dst key} {
+ $r del mylist
+ $r del newlist
+ $r rpush mylist a
+ $r rpush mylist b
+ $r rpush mylist c
+ $r rpush mylist d
+ $r set newlist x
+ catch {$r rpoplpush mylist newlist} err
+ list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
+ } {{a b c d} string ERR}
+
test {RENAME basic usage} {
$r set mykey hello
$r rename mykey mykey1
} {0}
test {DEL all keys again (DB 1)} {
- $r select 1
+ $r select 10
foreach key [$r keys *] {
$r del $key
}
set res [$r dbsize]
- $r select 0
+ $r select 9
format $res
} {0}
test {MOVE basic usage} {
$r set mykey foobar
- $r move mykey 1
+ $r move mykey 10
set res {}
lappend res [$r exists mykey]
lappend res [$r dbsize]
- $r select 1
+ $r select 10
lappend res [$r get mykey]
lappend res [$r dbsize]
- $r select 0
+ $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 1
+ $r move mykey 10
} {0}
test {SET/GET keys in different DBs} {
$r set a hello
$r set b world
- $r select 1
+ $r select 10
$r set a foo
$r set b bared
- $r select 0
+ $r select 9
set res {}
lappend res [$r get a]
lappend res [$r get b]
- $r select 1
+ $r select 10
lappend res [$r get a]
lappend res [$r get b]
- $r select 0
+ $r select 9
format $res
} {hello world foo bared}
lsort [$r smembers setres]
} {995 996 997 998 999}
+ test {SINTERSTORE with two sets, after a DEBUG RELOAD} {
+ $r debug reload
+ $r sinterstore setres set1 set2
+ lsort [$r smembers setres]
+ } {995 996 997 998 999}
+
test {SUNIONSTORE with two sets} {
$r sunionstore setres set1 set2
lsort [$r smembers setres]
} {{1 2 3} 0}
test {SAVE - make sure there are all the types as values} {
+ # Wait for a background saving in progress to terminate
+ while 1 {
+ set i [$r info]
+ if {[string match {*bgsave_in_progress:1*} $i]} {
+ puts -nonewline "\nWaiting for background save to finish... "
+ flush stdout
+ after 100
+ } else {
+ break
+ }
+ }
$r lpush mysavelist hello
$r lpush mysavelist world
$r set myemptykey {}
$r zadd mytestzset c 30
$r save
} {OK}
+
+ test {SRANDMEMBER} {
+ $r del myset
+ $r sadd myset a
+ $r sadd myset b
+ $r sadd myset c
+ unset -nocomplain myset
+ array set myset {}
+ for {set i 0} {$i < 100} {incr i} {
+ set myset([$r srandmember myset]) 1
+ }
+ lsort [array names myset]
+ } {a b c}
test {Create a random list} {
set tosort {}
$r sort mylist
} [lsort -real {1.1 5.10 3.10 7.44 2.1 5.75 6.12 0.25 1.15}]
+ test {SORT with GET #} {
+ $r del mylist
+ $r lpush mylist 1
+ $r lpush mylist 2
+ $r lpush mylist 3
+ $r mset weight_1 10 weight_2 5 weight_3 30
+ $r sort mylist BY weight_* GET #
+ } {2 1 3}
+
test {LREM, remove all the occurrences} {
- $r flushall
+ $r flushdb
$r rpush mylist foo
$r rpush mylist bar
$r rpush mylist foobar
} {{foobar foobared zap test foo} 0}
test {LREM, starting from tail with negative count} {
- $r flushall
+ $r flushdb
$r rpush mylist foo
$r rpush mylist bar
$r rpush mylist foobar
} {2}
test {MGET} {
- $r flushall
+ $r flushdb
$r set foo BAR
$r set bar FOO
$r mget foo bar
} {BAR {} FOO {}}
test {RANDOMKEY} {
- $r flushall
+ $r flushdb
$r set foo x
$r set bar y
set foo_seen 0
} {1 1}
test {RANDOMKEY against empty DB} {
- $r flushall
+ $r flushdb
$r randomkey
} {}
test {RANDOMKEY regression 1} {
- $r flushall
+ $r flushdb
$r set x 10
$r del x
$r randomkey
} {{x y z} {y x z}}
test {ZSCORE} {
- list [$r zscore ztmp x] [$r zscore ztmp y] [$r zscore ztmp z]
- } {10 1 30}
+ set aux {}
+ set err {}
+ for {set i 0} {$i < 1000} {incr i} {
+ set score [expr rand()]
+ lappend aux $score
+ $r zadd zscoretest $score $i
+ }
+ for {set i 0} {$i < 1000} {incr i} {
+ if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
+ set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
+ break
+ }
+ }
+ set _ $err
+ } {}
+
+ test {ZSCORE after a DEBUG RELOAD} {
+ set aux {}
+ set err {}
+ $r del zscoretest
+ for {set i 0} {$i < 1000} {incr i} {
+ set score [expr rand()]
+ lappend aux $score
+ $r zadd zscoretest $score $i
+ }
+ $r debug reload
+ for {set i 0} {$i < 1000} {incr i} {
+ if {[$r zscore zscoretest $i] != [lindex $aux $i]} {
+ set err "Expected score was [lindex $aux $i] but got [$r zscore zscoretest $i] for element $i"
+ break
+ }
+ }
+ set _ $err
+ } {}
test {ZRANGE and ZREVRANGE} {
list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1]
format $delta
} {0}
+ test {ZINCRBY - can create a new sorted set} {
+ $r del zset
+ $r zincrby zset 1 foo
+ list [$r zrange zset 0 -1] [$r zscore zset foo]
+ } {foo 1}
+
+ test {ZINCRBY - increment and decrement} {
+ $r zincrby zset 2 foo
+ $r zincrby zset 1 bar
+ set v1 [$r zrange zset 0 -1]
+ $r zincrby zset 10 bar
+ $r zincrby zset -5 foo
+ $r zincrby zset -5 bar
+ set v2 [$r zrange zset 0 -1]
+ list $v1 $v2 [$r zscore zset foo] [$r zscore zset bar]
+ } {{bar foo} {foo bar} -2 6}
+
+ test {EXPIRE - don't 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]
+ list $v1 $v2 $v3 $v4
+ } {1 5 0 5}
+
+ test {EXPIRE - It should be still possible to read 'x'} {
+ $r get x
+ } {foobar}
+
+ test {EXPIRE - After 6 seconds the key should no longer be here} {
+ after 6000
+ list [$r get x] [$r exists x]
+ } {{} 0}
+
+ test {EXPIRE - Delete on write policy} {
+ $r del x
+ $r lpush x foo
+ $r expire x 1000
+ $r lpush x bar
+ $r lrange x 0 -1
+ } {bar}
+
+ 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 {ZSETs skiplist implementation backlink consistency test} {
set diff 0
set elements 10000
}
# Leave the user with a clean DB before to exit
- test {FLUSHALL} {
- $r flushall
- $r dbsize
- } {0}
+ 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} {
+ $r save
+ } {OK}
puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
if {$::failed > 0} {
proc stress {} {
set r [redis]
- $r flushall
+ $r select 9
+ $r flushdb
while 1 {
set randkey [expr int(rand()*10000)]
set randval [expr int(rand()*10000)]
set randidx0 [expr int(rand()*10)]
set randidx1 [expr int(rand()*10)]
- set cmd [expr int(rand()*10)]
+ set cmd [expr int(rand()*20)]
catch {
if {$cmd == 0} {$r set $randkey $randval}
if {$cmd == 1} {$r get $randkey}
if {$cmd == 3} {$r lpush $randkey $randval}
if {$cmd == 4} {$r rpop $randkey}
if {$cmd == 5} {$r del $randkey}
- if {$cmd == 6} {$r lrange $randkey $randidx0 $randidx1}
- if {$cmd == 7} {$r ltrim $randkey $randidx0 $randidx1}
- if {$cmd == 8} {$r lindex $randkey $randidx0}
- if {$cmd == 9} {$r lset $randkey $randidx0 $randval}
+ if {$cmd == 6} {$r llen $randkey}
+ if {$cmd == 7} {$r lrange $randkey $randidx0 $randidx1}
+ if {$cmd == 8} {$r ltrim $randkey $randidx0 $randidx1}
+ if {$cmd == 9} {$r lindex $randkey $randidx0}
+ if {$cmd == 10} {$r lset $randkey $randidx0 $randval}
+ if {$cmd == 11} {$r sadd $randkey $randval}
+ if {$cmd == 12} {$r srem $randkey $randval}
+ if {$cmd == 13} {$r smove $randkey $randval}
+ if {$cmd == 14} {$r scard $randkey}
+ if {$cmd == 15} {$r expire $randkey [expr $randval%60]}
}
flush stdout
}
+ $r flushdb
$r close
}
+# Before to run the test check if DB 9 and DB 10 are empty
+set r [redis]
+$r select 9
+set db9size [$r dbsize]
+$r select 10
+set db10size [$r dbsize]
+if {$db9size != 0 || $db10size != 0} {
+ puts "Can't run the tests against DB 9 and 10: DBs are not empty."
+ exit 1
+}
+$r close
+unset r
+unset db9size
+unset db10size
+
if {[llength $argv] == 0} {
main 127.0.0.1 6379
} elseif {[llength $argv] == 1 && [lindex $argv 0] eq {stress}} {
projects / redis.git / blobdiff