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 f002dfa771056e9599e1e4871e647cd7485aea43..c0a025af2aecde808a002a6d54f8b4eeb33a3801 100644 (file)
--- a/test-redis.tcl
+++ b/test-redis.tcl
@@ -65,6 +65,19 @@ proc waitForBgsave r {
     }
 }
 
     }
 }
 

+proc waitForBgrewriteaof r {
+    while 1 {
+        set i [$r info]
+        if {[string match {*bgrewriteaof_in_progress:1*} $i]} {
+            puts -nonewline "\nWaiting for background AOF rewrite to finish... "
+            flush stdout
+            after 1000
+        } else {
+            break
+        }
+    }
+}
+

 proc randomInt {max} {
     expr {int(rand()*$max)}
 }
 proc randomInt {max} {
     expr {int(rand()*$max)}
 }


@@ -113,7 +126,19 @@ proc createComplexDataset {r ops} {
     for {set j 0} {$j < $ops} {incr j} {
         set k [randomKey]
         set v [randomValue]
     for {set j 0} {$j < $ops} {incr j} {
         set k [randomKey]
         set v [randomValue]

-        set d [expr {rand()}]
+        randpath {
+            set d [expr {rand()}]
+        } {
+            set d [expr {rand()}]
+        } {
+            set d [expr {rand()}]
+        } {
+            set d [expr {rand()}]
+        } {
+            set d [expr {rand()}]
+        } {
+            randpath {set d +inf} {set d -inf}
+        }

         set t [$r type $k]
 
         if {$t eq {none}} {
         set t [$r type $k]
 
         if {$t eq {none}} {


@@ -154,17 +179,36 @@ proc createComplexDataset {r ops} {
 
 proc datasetDigest r {
     set keys [lsort [split [$r keys *] " "]]
 
 proc datasetDigest r {
     set keys [lsort [split [$r keys *] " "]]

-    set digest [::sha1::sha1 -hex $keys]
+    set digest {}

     foreach k $keys {
         set t [$r type $k]
     foreach k $keys {
         set t [$r type $k]

-        switch t {
-            {string} {set aux [::sha1::sha1 -hex [$r get $k]]} \
-            {list} {set aux [::sha1::sha1 -hex [$r lrange $k 0 -1]]} \
-            {set} {set aux [::sha1::sha1 -hex [$r smembers $k]]} \
-            {zset} {set aux [::sha1::sha1 -hex [$r zrange $k 0 -1]]}
+        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]]
+                }
+            } default {
+                error "Type not supported"
+            }

         }
         }

-        append aux $digest
-        set digest [::sha1::sha1 -hex $aux]
+        if {$aux eq {}} continue
+        set digest [::sha1::sha1 -hex [join [list $aux $digest $k] "\n"]]

     }
     return $digest
 }
     }
     return $digest
 }


@@ -236,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 {}


@@ -276,6 +346,11 @@ proc main {server port} {
         $r incrby novar 17179869184
     } {34359738368}
 
         $r incrby novar 17179869184
     } {34359738368}
 

+    test {INCR against key with spaces (no integer encoded)} {
+        $r set novar "    11    "
+        $r incr novar
+    } {12}
+

     test {DECRBY over 32bit value with over 32bit increment, negative res} {
         $r set novar 17179869184
         $r decrby novar 17179869185
     test {DECRBY over 32bit value with over 32bit increment, negative res} {
         $r set novar 17179869184
         $r decrby novar 17179869185


@@ -338,7 +413,8 @@ proc main {server port} {
         append res [$r lindex mylist 0]
         append res [$r lindex mylist 1]
         append res [$r lindex mylist 2]
         append res [$r lindex mylist 0]
         append res [$r lindex mylist 1]
         append res [$r lindex mylist 2]

-    } {3bac}
+        list $res [$r lindex mylist 100]
+    } {3bac {}}

 
     test {DEL a list} {
         $r del mylist
 
     test {DEL a list} {
         $r del mylist


@@ -391,11 +467,19 @@ proc main {server port} {
         format $err
     } {ERR*}
 
         format $err
     } {ERR*}
 

+    test {LLEN against non existing key} {
+        $r llen not-a-key
+    } {0}
+

     test {LINDEX against non-list value error} {
         catch {$r lindex mylist 0} err
         format $err
     } {ERR*}
 
     test {LINDEX against non-list value error} {
         catch {$r lindex mylist 0} err
         format $err
     } {ERR*}
 

+    test {LINDEX against non existing key} {
+        $r lindex not-a-key 10
+    } {}
+

     test {LPUSH against non-list value error} {
         catch {$r lpush mylist 0} err
         format $err
     test {LPUSH against non-list value error} {
         catch {$r lpush mylist 0} err
         format $err


@@ -472,6 +556,12 @@ proc main {server port} {
         list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
     } {{a b c d} string ERR}
 
         list [$r lrange mylist 0 -1] [$r type newlist] [string range $err 0 2]
     } {{a b c d} string ERR}
 

+    test {RPOPLPUSH against non existing src key} {
+        $r del mylist
+        $r del newlist
+        $r rpoplpush mylist newlist
+    } {}
+

     test {RENAME basic usage} {
         $r set mykey hello
         $r rename mykey mykey1
     test {RENAME basic usage} {
         $r set mykey hello
         $r rename mykey mykey1


@@ -635,7 +725,36 @@ proc main {server port} {
         $r lrange mylist 0 -1
     } {99 98 97 96 95}
 
         $r lrange mylist 0 -1
     } {99 98 97 96 95}
 

+    test {LTRIM stress testing} {
+        set mylist {}
+        set err {}
+        for {set i 0} {$i < 20} {incr i} {
+            lappend mylist $i
+        }
+
+        for {set j 0} {$j < 100} {incr j} {
+            # Fill the list
+            $r del mylist
+            for {set i 0} {$i < 20} {incr i} {
+                $r rpush mylist $i
+            }
+            # Trim at random
+            set a [randomInt 20]
+            set b [randomInt 20]
+            $r ltrim mylist $a $b
+            if {[$r lrange mylist 0 -1] ne [lrange $mylist $a $b]} {
+                set err "[$r lrange mylist 0 -1] != [lrange $mylist $a $b]"
+                break
+            }
+        }
+        set _ $err
+    } {}
+

     test {LSET} {
     test {LSET} {

+        $r del mylist
+        foreach x {99 98 97 96 95} {
+            $r rpush mylist $x
+        }

         $r lset mylist 1 foo
         $r lset mylist -1 bar
         $r lrange mylist 0 -1
         $r lset mylist 1 foo
         $r lset mylist -1 bar
         $r lrange mylist 0 -1


@@ -784,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]
         }


@@ -811,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]


@@ -869,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


@@ -1091,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


@@ -1392,8 +1534,72 @@ proc main {server port} {
             set sha1_after [datasetDigest $r]
             expr {$sha1 eq $sha1_after}
         } {1}
             set sha1_after [datasetDigest $r]
             expr {$sha1 eq $sha1_after}
         } {1}

+
+        test {Same dataset digest if saving/reloading as AOF?} {
+            $r bgrewriteaof
+            waitForBgrewriteaof $r
+            $r debug loadaof
+            set sha1_after [datasetDigest $r]
+            expr {$sha1 eq $sha1_after}
+        } {1}

     }
 
     }
 

+    test {EXPIRES after a reload (snapshot + append only file)} {
+        $r flushdb
+        $r set x 10
+        $r expire x 1000
+        $r save
+        $r debug reload
+        set ttl [$r ttl x]
+        set e1 [expr {$ttl > 900 && $ttl <= 1000}]
+        $r bgrewriteaof
+        waitForBgrewriteaof $r
+        set ttl [$r ttl x]
+        set e2 [expr {$ttl > 900 && $ttl <= 1000}]
+        list $e1 $e2
+    } {1 1}
+
+    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 {}
+            set val "0000${i}0000"
+            append q "SET key:$i [string length $val]\r\n$val\r\n"
+            puts -nonewline $fd2 $q
+            set q {}
+            append q "GET key:$i\r\n"
+            puts -nonewline $fd2 $q
+        }
+        flush $fd2
+
+        for {set i 0} {$i < 100000} {incr i} {
+            gets $fd2 line
+            gets $fd2 count
+            set count [string range $count 1 end]
+            set val [read $fd2 $count]
+            read $fd2 2
+        }
+        close $fd2
+        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 {}