one more fix for endianess detection

[redis.git] / test-redis.tcl

diff --git a/test-redis.tcl b/test-redis.tcl
index 00370a4c4b955f8bc442d135613dfad3661b7f4f..3b5900f96894acf32f8a0baf5d271818fd97fafa 100644 (file)
--- 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
     }
         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 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]
 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()}]
         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 sadd $k $v
             } {
                 $r zadd $k $d $v

+            } {
+                $r hset $k $f $v

             }
             set t [$r type $k]
         }
             }
             set t [$r type $k]
         }


@@ -173,55 +182,27 @@ proc createComplexDataset {r ops} {
                 randpath {$r zadd $k $d $v} \
                         {$r zrem $k $v}
             }
                 randpath {$r zadd $k $d $v} \
                         {$r zrem $k $v}
             }

+            {hash} {
+                randpath {$r hset $k $f $v} \
+                        {$r hdel $k $f}
+            }

         }
     }
 }
 
 proc datasetDigest r {
         }
     }
 }
 
 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]]
-                }
-            } 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
     $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
 
     #test {AUTH with requirepass in redis.conf} {
     #    $r auth foobared


@@ -346,10 +327,18 @@ proc main {server port} {
         $r incrby novar 17179869184
     } {34359738368}
 
         $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 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 {DECRBY over 32bit value with over 32bit increment, negative res} {
         $r set novar 17179869184


@@ -818,7 +807,7 @@ proc main {server port} {
     test {SUNION with two sets} {
         lsort [$r sunion set1 set2]
     } [lsort -uniq "[$r smembers set1] [$r smembers set2]"]
     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]
     test {SINTERSTORE with two sets} {
         $r sinterstore setres set1 set2
         lsort [$r smembers setres]


@@ -889,9 +878,9 @@ proc main {server port} {
         $r lpush mysavelist world
         $r set myemptykey {}
         $r set mynormalkey {blablablba}
         $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}
 
         $r save
     } {OK}
 


@@ -907,7 +896,16 @@ proc main {server port} {
         }
         lsort [array names myset]
     } {a b c}
         }
         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 {}
     test {Create a random list and a random set} {
         set tosort {}
         array set seenrand {}


@@ -926,6 +924,7 @@ proc main {server port} {
             $r lpush tosort $i
             $r sadd tosort-set $i
             $r set weight_$i $rint
             $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]
             lappend tosort [list $i $rint]
         }
         set sorted [lsort -index 1 -real $tosort]


@@ -940,15 +939,46 @@ 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} {
+    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
 
         $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 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]
     test {SORT direct, numeric, against the newly created list} {
         $r sort tosort
     } [lsort -integer $res]


@@ -968,6 +998,17 @@ proc main {server port} {
         format {}
     } {}
 
         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} {
     test {SORT speed, sorting 10000 elements list directly, 100 times} {
         set start [clock clicks -milliseconds]
         for {set i 0} {$i < 100} {incr i} {


@@ -1476,6 +1517,11 @@ proc main {server port} {
         list [$r zremrangebyrank zset 1 3] [$r zrange zset 0 -1]
     } {3 {a e}}
 
         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
     test {ZUNION basics} {
         $r del zseta zsetb zsetc
         $r zadd zseta 1 a


@@ -1491,6 +1537,14 @@ proc main {server port} {
         list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
     } {4 {a 2 b 7 d 9 c 12}}
 
         list [$r zunion zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
     } {4 {a 2 b 7 d 9 c 12}}
 

+    test {ZUNION with AGGREGATE MIN} {
+        list [$r zunion zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
+    } {4 {a 1 b 1 c 2 d 3}}
+
+    test {ZUNION with AGGREGATE MAX} {
+        list [$r zunion zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
+    } {4 {a 1 b 2 c 3 d 3}}
+

     test {ZINTER basics} {
         list [$r zinter zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
     } {2 {b 3 c 5}}
     test {ZINTER basics} {
         list [$r zinter zsetc 2 zseta zsetb] [$r zrange zsetc 0 -1 withscores]
     } {2 {b 3 c 5}}


@@ -1499,6 +1553,14 @@ proc main {server port} {
         list [$r zinter zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
     } {2 {b 7 c 12}}
 
         list [$r zinter zsetc 2 zseta zsetb weights 2 3] [$r zrange zsetc 0 -1 withscores]
     } {2 {b 7 c 12}}
 

+    test {ZINTER with AGGREGATE MIN} {
+        list [$r zinter zsetc 2 zseta zsetb aggregate min] [$r zrange zsetc 0 -1 withscores]
+    } {2 {b 1 c 2}}
+
+    test {ZINTER with AGGREGATE MAX} {
+        list [$r zinter zsetc 2 zseta zsetb aggregate max] [$r zrange zsetc 0 -1 withscores]
+    } {2 {b 2 c 3}}
+

     test {SORT against sorted sets} {
         $r del zset
         $r zadd zset 1 a
     test {SORT against sorted sets} {
         $r del zset
         $r zadd zset 1 a


@@ -1520,6 +1582,298 @@ proc main {server port} {
         $r zrange zset 0 -1
     } {min c a b d max}
 
         $r zrange zset 0 -1
     } {min c a b d max}
 

+    test {HSET/HLEN - Small hash creation} {
+        array set smallhash {}
+        for {set i 0} {$i < 8} {incr i} {
+            set key [randstring 0 8 alpha]
+            set val [randstring 0 8 alpha]
+            if {[info exists smallhash($key)]} {
+                incr i -1
+                continue
+            }
+            $r hset smallhash $key $val
+            set smallhash($key) $val
+        }
+        list [$r hlen smallhash]
+    } {8}
+
+    test {Is the small hash encoded with a zipmap?} {
+        $r debug object smallhash
+    } {*zipmap*}
+
+    test {HSET/HLEN - Big hash creation} {
+        array set bighash {}
+        for {set i 0} {$i < 1024} {incr i} {
+            set key [randstring 0 8 alpha]
+            set val [randstring 0 8 alpha]
+            if {[info exists bighash($key)]} {
+                incr i -1
+                continue
+            }
+            $r hset bighash $key $val
+            set bighash($key) $val
+        }
+        list [$r hlen bighash]
+    } {1024}
+
+    test {Is the big hash encoded with a zipmap?} {
+        $r debug object bighash
+    } {*hashtable*}
+
+    test {HGET against the small hash} {
+        set err {}
+        foreach k [array names smallhash *] {
+            if {$smallhash($k) ne [$r hget smallhash $k]} {
+                set err "$smallhash($k) != [$r hget smallhash $k]"
+                break
+            }
+        }
+        set _ $err
+    } {}
+
+    test {HGET against the big hash} {
+        set err {}
+        foreach k [array names bighash *] {
+            if {$bighash($k) ne [$r hget bighash $k]} {
+                set err "$bighash($k) != [$r hget bighash $k]"
+                break
+            }
+        }
+        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]
+        lappend rv [$r hset smallhash $k newval1]
+        set smallhash($k) newval1
+        lappend rv [$r hget smallhash $k]
+        lappend rv [$r hset smallhash __foobar123__ newval]
+        set k [lindex [array names bighash *] 0]
+        lappend rv [$r hset bighash $k newval2]
+        set bighash($k) newval2
+        lappend rv [$r hget bighash $k]
+        lappend rv [$r hset bighash __foobar123__ newval]
+        lappend rv [$r hdel smallhash __foobar123__]
+        lappend rv [$r hdel bighash __foobar123__]
+        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
+    } {*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 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 *]]
+
+    test {HKEYS - big hash} {
+        lsort [$r hkeys bighash]
+    } [lsort [array names bighash *]]
+
+    test {HVALS - small hash} {
+        set vals {}
+        foreach {k v} [array get smallhash] {
+            lappend vals $v
+        }
+        set _ [lsort $vals]
+    } [lsort [$r hvals smallhash]]
+
+    test {HVALS - big hash} {
+        set vals {}
+        foreach {k v} [array get bighash] {
+            lappend vals $v
+        }
+        set _ [lsort $vals]
+    } [lsort [$r hvals bighash]]
+
+    test {HGETALL - small hash} {
+        lsort [$r hgetall smallhash]
+    } [lsort [array get smallhash]]
+
+    test {HGETALL - big hash} {
+        lsort [$r hgetall bighash]
+    } [lsort [array get bighash]]
+
+    test {HDEL and return value} {
+        set rv {}
+        lappend rv [$r hdel smallhash nokey]
+        lappend rv [$r hdel bighash nokey]
+        set k [lindex [array names smallhash *] 0]
+        lappend rv [$r hdel smallhash $k]
+        lappend rv [$r hdel smallhash $k]
+        lappend rv [$r hget smallhash $k]
+        unset smallhash($k)
+        set k [lindex [array names bighash *] 0]
+        lappend rv [$r hdel bighash $k]
+        lappend rv [$r hdel bighash $k]
+        lappend rv [$r hget bighash $k]
+        unset bighash($k)
+        set _ $rv
+    } {0 0 1 0 {} 1 0 {}}
+
+    test {HEXISTS} {
+        set rv {}
+        set k [lindex [array names smallhash *] 0]
+        lappend rv [$r hexists smallhash $k]
+        lappend rv [$r hexists smallhash nokey]
+        set k [lindex [array names bighash *] 0]
+        lappend rv [$r hexists bighash $k]
+        lappend rv [$r hexists bighash nokey]
+    } {1 0 1 0}
+
+    test {Is a zipmap encoded Hash promoted on big payload?} {
+        $r hset smallhash foo [string repeat a 1024]
+        $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 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
+    # .rdb / AOF consistency test should include hashes
+

     test {EXPIRE - don't set timeouts multiple times} {
         $r set x foobar
         set v1 [$r expire x 5]
     test {EXPIRE - don't set timeouts multiple times} {
         $r set x foobar
         set v1 [$r expire x 5]


@@ -1553,6 +1907,30 @@ proc main {server port} {
         $r ttl x
     } {1[345]}
 
         $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
     test {ZSETs skiplist implementation backlink consistency test} {
         set diff 0
         set elements 10000


@@ -1702,7 +2080,7 @@ proc main {server port} {
     } {1 1}
 
     test {PIPELINING stresser (also a regression for the old epoll bug)} {
     } {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
         fconfigure $fd2 -encoding binary -translation binary
         puts -nonewline $fd2 "SELECT 9\r\n"
         flush $fd2


@@ -1759,6 +2137,17 @@ proc main {server port} {
              [$r append foo 100] [$r get foo]
     } {3 bar 6 bar100}
 
              [$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} {
     test {APPEND fuzzing} {
         set err {}
         foreach type {binary alpha compr} {


@@ -1777,6 +2166,42 @@ proc main {server port} {
         set _ $err
     } {}
 
         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 {}
     # Leave the user with a clean DB before to exit
     test {FLUSHDB} {
         set aux {}


@@ -1807,7 +2232,7 @@ proc main {server port} {
 }
 
 proc stress {} {
 }
 
 proc stress {} {

-    set r [redis]
+    set r [redis $::host $::port]

     $r select 9
     $r flushdb
     while 1 {
     $r select 9
     $r flushdb
     while 1 {


@@ -1844,6 +2269,7 @@ proc stress {} {
 set ::host 127.0.0.1
 set ::port 6379
 set ::stress 0
 set ::host 127.0.0.1
 set ::port 6379
 set ::stress 0

+set ::traceleaks 0

 set ::flush 0
 set ::first 0
 set ::last 1000000
 set ::flush 0
 set ::first 0
 set ::last 1000000


@@ -1859,8 +2285,10 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
     } elseif {$opt eq {-p} && !$lastarg} {
         set ::port $arg
         incr j
     } elseif {$opt eq {-p} && !$lastarg} {
         set ::port $arg
         incr j

-    } elseif {$opt eq {-stress}} {
+    } elseif {$opt eq {--stress}} {

         set ::stress 1
         set ::stress 1

+    } elseif {$opt eq {--trace-leaks}} {
+        set ::traceleaks 1

     } elseif {$opt eq {--flush}} {
         set ::flush 1
     } elseif {$opt eq {--first} && !$lastarg} {
     } elseif {$opt eq {--flush}} {
         set ::flush 1
     } elseif {$opt eq {--first} && !$lastarg} {


@@ -1876,7 +2304,7 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
 }
 
 # Before to run the test check if DB 9 and DB 10 are empty
 }
 
 # 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
 
 if {$::flush} {
     $r flushall


@@ -1895,8 +2323,9 @@ unset r
 unset db9size
 unset db10size
 
 unset db9size
 unset db10size
 

+puts "Testing Redis, host $::host, port $::port"

 if {$::stress} {
     stress
 } else {
 if {$::stress} {
     stress
 } else {

-    main $::host $::port
+    main

 }
 }