}
}
+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 randpath args {
+ set path [expr {int(rand()*[llength $args])}]
+ uplevel 1 [lindex $args $path]
+}
+
+proc randomValue {} {
+ randpath {
+ # Small enough to likely collide
+ randomInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomInt 2000000000} {randomInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 0 256 alpha} \
+ {randstring 0 256 compr} \
+ {randstring 0 256 binary}
+ }
+}
+
+proc randomKey {} {
+ randpath {
+ # Small enough to likely collide
+ randomInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomInt 2000000000} {randomInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 1 256 alpha} \
+ {randstring 1 256 compr}
+ }
+}
+
+proc createComplexDataset {r ops} {
+ for {set j 0} {$j < $ops} {incr j} {
+ set k [randomKey]
+ set v [randomValue]
+ set d [expr {rand()}]
+ set t [$r type $k]
+
+ if {$t eq {none}} {
+ randpath {
+ $r set $k $v
+ } {
+ $r lpush $k $v
+ } {
+ $r sadd $k $v
+ } {
+ $r zadd $k $d $v
+ }
+ set t [$r type $k]
+ }
+
+ switch $t {
+ {string} {
+ # Nothing to do
+ }
+ {list} {
+ randpath {$r lpush $k $v} \
+ {$r rpush $k $v} \
+ {$r lrem $k 0 $v} \
+ {$r rpop $k} \
+ {$r lpop $k}
+ }
+ {set} {
+ randpath {$r sadd $k $v} \
+ {$r srem $k $v}
+ }
+ {zset} {
+ randpath {$r zadd $k $d $v} \
+ {$r zrem $k $v}
+ }
+ }
+ }
+}
+
+proc datasetDigest r {
+ set keys [lsort [split [$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"
+ }
+ }
+ if {$aux eq {}} continue
+ set digest [::sha1::sha1 -hex [join [list $aux $digest $k] "\n"]]
+ }
+ return $digest
+}
+
proc main {server port} {
set r [redis $server $port]
$r select 9
$r get x
} {foobar}
+ test {SET and GET an empty item} {
+ $r set x {}
+ $r get x
+ } {}
+
test {DEL against a single item} {
$r del x
$r get x
$r get x
} {10}
+ test {Handle an empty query well} {
+ set fd [$r channel]
+ puts -nonewline $fd "\r\n"
+ flush $fd
+ $r ping
+ } {PONG}
+
+ test {Negative multi bulk command does not create problems} {
+ set fd [$r channel]
+ puts -nonewline $fd "*-10\r\n"
+ flush $fd
+ $r ping
+ } {PONG}
+
+ test {Negative multi bulk payload} {
+ set fd [$r channel]
+ puts -nonewline $fd "SET x -10\r\n"
+ flush $fd
+ gets $fd
+ } {*invalid bulk*}
+
+ test {Too big bulk payload} {
+ set fd [$r channel]
+ puts -nonewline $fd "SET x 2000000000\r\n"
+ flush $fd
+ gets $fd
+ } {*invalid bulk*count*}
+
+ test {Multi bulk request not followed by bulk args} {
+ set fd [$r channel]
+ puts -nonewline $fd "*1\r\nfoo\r\n"
+ flush $fd
+ gets $fd
+ } {*protocol error*}
+
+ test {Generic wrong number of args} {
+ catch {$r ping x y z} err
+ set _ $err
+ } {*wrong*arguments*ping*}
+
+ test {SELECT an out of range DB} {
+ catch {$r select 1000000} err
+ set _ $err
+ } {*invalid*}
+
+ if {![catch {package require sha1}]} {
+ test {Check consistency of different data types after a reload} {
+ $r flushdb
+ createComplexDataset $r 10000
+ set sha1 [datasetDigest $r]
+ $r debug reload
+ 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}
+
# Leave the user with a clean DB before to exit
test {FLUSHDB} {
set aux {}
set ::last $arg
incr j
} else {
- echo "Wrong argument: $opt"
+ puts "Wrong argument: $opt"
exit 1
}
}