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 datasetDigest r {
- set keys [lsort [$r keys *]]
- set digest {}
- foreach k $keys {
- set t [$r type $k]
- switch $t {
- {string} {
- set aux [::sha1::sha1 -hex [$r get $k]]
- } {list} {
- if {[$r llen $k] == 0} {
- set aux {}
- } else {
- set aux [::sha1::sha1 -hex [$r lrange $k 0 -1]]
- }
- } {set} {
- if {[$r scard $k] == 0} {
- set aux {}
- } else {
- set aux [::sha1::sha1 -hex [lsort [$r smembers $k]]]
- }
- } {zset} {
- if {[$r zcard $k] == 0} {
- set aux {}
- } else {
- set aux [::sha1::sha1 -hex [$r zrange $k 0 -1]]
- }
- } {hash} {
- if {[$r hlen $k] == 0} {
- set aux {}
- } else {
- set aux [::sha1::sha1 -hex [lsort [$r hgetall $k]]]
- }
- } default {
- error "Type not supported: $t"
- }
- }
- if {$aux eq {}} continue
- set digest [::sha1::sha1 -hex [join [list $aux $digest $k] "\n"]]
- }
- return $digest
+ $r debug 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 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
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 {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 {}
$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 {the same SORT with BY, but against the newly created set} {
+ 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} {
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
$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 *]]
list [$r hincrby smallhash tmp 17179869184] [$r hincrby bighash tmp 17179869184]
} {34359738368 34359738368}
- test {HINCRBY against key with spaces (no integer encoded)} {
- $r hset smallhash tmp " 11 "
- $r hset bighash tmp " 11 "
- list [$r hincrby smallhash tmp 1] [$r hincrby bighash tmp 1]
- } {12 12}
+ 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
$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
} {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
[$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 _ $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