X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/b4eb9ccdcbc126e9b828f7fc8d0bcd40bd1891a0..b4bd05241da2772f457d0552d807e7cfd4dc8f33:/test-redis.tcl diff --git a/test-redis.tcl b/test-redis.tcl index 800a93ea..8f71c624 100644 --- a/test-redis.tcl +++ b/test-redis.tcl @@ -935,6 +935,15 @@ proc main {} { 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 {} @@ -953,6 +962,7 @@ proc main {} { $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] @@ -967,15 +977,46 @@ proc main {} { $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] @@ -995,6 +1036,17 @@ proc main {} { 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} { @@ -1889,6 +1941,30 @@ proc main {} { $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 @@ -2095,6 +2171,17 @@ proc main {} { [$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} { @@ -2113,6 +2200,42 @@ proc main {} { 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 {}