Faster version of the function hashing possibly encoded objects, leading to a general...

[redis.git] / test-redis.tcl

diff --git a/test-redis.tcl b/test-redis.tcl
index 004dc696cfa91673b85f365f17e816dc12e22642..c0a025af2aecde808a002a6d54f8b4eeb33a3801 100644 (file)
--- a/test-redis.tcl
+++ b/test-redis.tcl
@@ -280,20 +280,46 @@ proc main {server port} {
         $r get foo
     } [string repeat "abcd" 1000000]
 
         $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} {
     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} {
         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
         $r dbsize

-    } {10001}
+    } {10101}

 
     test {INCR against non existing key} {
         set res {}
 
     test {INCR against non existing key} {
         set res {}


@@ -877,18 +903,23 @@ proc main {server port} {
         lsort [array names myset]
     } {a b c}
     
         lsort [array names myset]
     } {a b c}
     

-    test {Create a random list} {
+    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 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
                 if {![info exists seenrand($rint)]} break
             }
             set seenrand($rint) x
             $r lpush tosort $i

+            $r sadd tosort-set $i

             $r set weight_$i $rint
             lappend tosort [list $i $rint]
         }
             $r set weight_$i $rint
             lappend tosort [list $i $rint]
         }


@@ -904,6 +935,15 @@ proc main {server port} {
         $r sort tosort {BY weight_*}
     } $res
 
         $r sort tosort {BY weight_*}
     } $res
 

+    test {the same SORT with BY, but against the newly created set} {
+        $r sort tosort-set {BY 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 direct, numeric, against the newly created list} {
         $r sort tosort
     } [lsort -integer $res]
     test {SORT direct, numeric, against the newly created list} {
         $r sort tosort
     } [lsort -integer $res]


@@ -962,6 +1002,10 @@ proc main {server port} {
         $r sort mylist BY weight_* GET #
     } {2 1 3}
 
         $r sort mylist BY weight_* GET #
     } {2 1 3}
 

+    test {SORT with constant GET} {
+        $r sort mylist GET foo
+    } {{} {} {}}
+

     test {LREM, remove all the occurrences} {
         $r flushdb
         $r rpush mylist foo
     test {LREM, remove all the occurrences} {
         $r flushdb
         $r rpush mylist foo


@@ -1184,9 +1228,14 @@ proc main {server port} {
         set _ $err
     } {}
 
         set _ $err
     } {}
 

-    test {ZRANGE and ZREVRANGE} {
-        list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1]
-    } {{y x z} {z x y}}
+    test {ZRANGE and ZREVRANGE basics} {
+        list [$r zrange ztmp 0 -1] [$r zrevrange ztmp 0 -1] \
+            [$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
 
     test {ZSETs stress tester - sorting is working well?} {
         set delta 0


@@ -1513,6 +1562,9 @@ proc main {server port} {
     test {PIPELINING stresser (also a regression for the old epoll bug)} {
         set fd2 [socket 127.0.0.1 6379]
         fconfigure $fd2 -encoding binary -translation binary
     test {PIPELINING stresser (also a regression for the old epoll bug)} {
         set fd2 [socket 127.0.0.1 6379]
         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 {}
 
         for {set i 0} {$i < 100000} {incr i} {
             set q {}


@@ -1536,6 +1588,18 @@ proc main {server port} {
         set _ 1
     } {1}
 
         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}}
+

     # Leave the user with a clean DB before to exit
     test {FLUSHDB} {
         set aux {}
     # Leave the user with a clean DB before to exit
     test {FLUSHDB} {
         set aux {}