X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/17d68f9c99cd629591527d4c385ed0b1244726c5..c44d3b56df4ce4cae1c2e6db6397eaab9651ff7a:/test-redis.tcl?ds=sidebyside diff --git a/test-redis.tcl b/test-redis.tcl index d7a4d7fd..800a93ea 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}} { @@ -125,6 +131,7 @@ proc randomKey {} { 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()}] @@ -150,6 +157,8 @@ proc createComplexDataset {r ops} { $r sadd $k $v } { $r zadd $k $d $v + } { + $r hset $k $f $v } set t [$r type $k] } @@ -173,6 +182,10 @@ proc createComplexDataset {r ops} { randpath {$r zadd $k $d $v} \ {$r zrem $k $v} } + {hash} { + randpath {$r hset $k $f $v} \ + {$r hdel $k $f} + } } } } @@ -203,6 +216,12 @@ proc datasetDigest r { } 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" } @@ -213,15 +232,15 @@ proc datasetDigest r { 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 # 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 @@ -346,10 +365,18 @@ proc main {server port} { $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 novar} err + $r rpop mylist + format $err + } {ERR*} test {DECRBY over 32bit value with over 32bit increment, negative res} { $r set novar 17179869184 @@ -818,7 +845,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] @@ -889,9 +916,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} @@ -907,7 +934,7 @@ proc main {server port} { } lsort [array names myset] } {a b c} - + test {Create a random list and a random set} { set tosort {} array set seenrand {} @@ -1476,6 +1503,11 @@ proc main {server port} { 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 @@ -1596,6 +1628,13 @@ proc main {server port} { 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] @@ -1613,12 +1652,94 @@ proc main {server port} { set _ $rv } {0 newval1 1 0 newval2 1 1 1} - test {HGET against non existing key} { + 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 hget smallhash __123123123__] - lappend rv [$r hget bighash __123123123__] + 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] @@ -1684,6 +1805,53 @@ proc main {server port} { $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 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} + # TODO: # Randomized test, small and big # .rdb / AOF consistency test should include hashes @@ -1870,7 +2038,7 @@ proc main {server port} { } {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 @@ -1975,7 +2143,7 @@ proc main {server port} { } proc stress {} { - set r [redis] + set r [redis $::host $::port] $r select 9 $r flushdb while 1 { @@ -2012,6 +2180,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 @@ -2027,8 +2196,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} { @@ -2044,7 +2215,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 @@ -2063,8 +2234,9 @@ unset r unset db9size unset db10size +puts "Testing Redis, host $::host, port $::port" if {$::stress} { stress } else { - main $::host $::port + main }