tests/unit/other.tcl

   1 start_server {} {
   2     test {SAVE - make sure there are all the types as values} {
   3         # Wait for a background saving in progress to terminate
   4         waitForBgsave r
   5         r lpush mysavelist hello
   6         r lpush mysavelist world
   7         r set myemptykey {}
   8         r set mynormalkey {blablablba}
   9         r zadd mytestzset 10 a
  10         r zadd mytestzset 20 b
  11         r zadd mytestzset 30 c
  12         r save
  13     } {OK}
  14
  15     tags {"slow"} {
  16         foreach fuzztype {binary alpha compr} {
  17             test "FUZZ stresser with data model $fuzztype" {
  18                 set err 0
  19                 for {set i 0} {$i < 10000} {incr i} {
  20                     set fuzz [randstring 0 512 $fuzztype]
  21                     r set foo $fuzz
  22                     set got [r get foo]
  23                     if {$got ne $fuzz} {
  24                         set err [list $fuzz $got]
  25                         break
  26                     }
  27                 }
  28                 set _ $err
  29             } {0}
  30         }
  31     }
  32
  33     test {BGSAVE} {
  34         waitForBgsave r
  35         r flushdb
  36         r save
  37         r set x 10
  38         r bgsave
  39         waitForBgsave r
  40         r debug reload
  41         r get x
  42     } {10}
  43
  44     test {SELECT an out of range DB} {
  45         catch {r select 1000000} err
  46         set _ $err
  47     } {*invalid*}
  48
  49     tags {consistency} {
  50         if {![catch {package require sha1}]} {
  51             test {Check consistency of different data types after a reload} {
  52                 r flushdb
  53                 createComplexDataset r 10000
  54                 set dump [csvdump r]
  55                 set sha1 [r debug digest]
  56                 r debug reload
  57                 r set baubau x
  58                 set sha1_after [r debug digest]
  59                 if {$sha1 eq $sha1_after} {
  60                     set _ 1
  61                 } else {
  62                     set newdump [csvdump r]
  63                     puts "Consistency test failed!"
  64                     puts "You can inspect the two dumps in /tmp/repldump*.txt"
  65
  66                     set fd [open /tmp/repldump1.txt w]
  67                     puts $fd $dump
  68                     close $fd
  69                     set fd [open /tmp/repldump2.txt w]
  70                     puts $fd $newdump
  71                     close $fd
  72
  73                     set _ 0
  74                 }
  75             } {1}
  76
  77             test {Same dataset digest if saving/reloading as AOF?} {
  78                 r bgrewriteaof
  79                 waitForBgrewriteaof r
  80                 r debug loadaof
  81                 set sha1_after [r debug digest]
  82                 if {$sha1 eq $sha1_after} {
  83                     set _ 1
  84                 } else {
  85                     set newdump [csvdump r]
  86                     puts "Consistency test failed!"
  87                     puts "You can inspect the two dumps in /tmp/aofdump*.txt"
  88
  89                     set fd [open /tmp/aofdump1.txt w]
  90                     puts $fd $dump
  91                     close $fd
  92                     set fd [open /tmp/aofdump2.txt w]
  93                     puts $fd $newdump
  94                     close $fd
  95
  96                     set _ 0
  97                 }
  98             } {1}
  99         }
 100     }
 101
 102     test {EXPIRES after a reload (snapshot + append only file)} {
 103         r flushdb
 104         r set x 10
 105         r expire x 1000
 106         r save
 107         r debug reload
 108         set ttl [r ttl x]
 109         set e1 [expr {$ttl > 900 && $ttl <= 1000}]
 110         r bgrewriteaof
 111         waitForBgrewriteaof r
 112         set ttl [r ttl x]
 113         set e2 [expr {$ttl > 900 && $ttl <= 1000}]
 114         list $e1 $e2
 115     } {1 1}
 116
 117     test {PIPELINING stresser (also a regression for the old epoll bug)} {
 118         set fd2 [socket $::host $::port]
 119         fconfigure $fd2 -encoding binary -translation binary
 120         puts -nonewline $fd2 "SELECT 9\r\n"
 121         flush $fd2
 122         gets $fd2
 123
 124         for {set i 0} {$i < 100000} {incr i} {
 125             set q {}
 126             set val "0000${i}0000"
 127             append q "SET key:$i [string length $val]\r\n$val\r\n"
 128             puts -nonewline $fd2 $q
 129             set q {}
 130             append q "GET key:$i\r\n"
 131             puts -nonewline $fd2 $q
 132         }
 133         flush $fd2
 134
 135         for {set i 0} {$i < 100000} {incr i} {
 136             gets $fd2 line
 137             gets $fd2 count
 138             set count [string range $count 1 end]
 139             set val [read $fd2 $count]
 140             read $fd2 2
 141         }
 142         close $fd2
 143         set _ 1
 144     } {1}
 145
 146     test {MUTLI / EXEC basics} {
 147         r del mylist
 148         r rpush mylist a
 149         r rpush mylist b
 150         r rpush mylist c
 151         r multi
 152         set v1 [r lrange mylist 0 -1]
 153         set v2 [r ping]
 154         set v3 [r exec]
 155         list $v1 $v2 $v3
 156     } {QUEUED QUEUED {{a b c} PONG}}
 157
 158     test {DISCARD} {
 159         r del mylist
 160         r rpush mylist a
 161         r rpush mylist b
 162         r rpush mylist c
 163         r multi
 164         set v1 [r del mylist]
 165         set v2 [r discard]
 166         set v3 [r lrange mylist 0 -1]
 167         list $v1 $v2 $v3
 168     } {QUEUED OK {a b c}}
 169
 170     test {Nested MULTI are not allowed} {
 171         set err {}
 172         r multi
 173         catch {[r multi]} err
 174         r exec
 175         set _ $err
 176     } {*ERR MULTI*}
 177
 178     test {WATCH inside MULTI is not allowed} {
 179         set err {}
 180         r multi
 181         catch {[r watch x]} err
 182         r exec
 183         set _ $err
 184     } {*ERR WATCH*}
 185
 186     test {APPEND basics} {
 187         list [r append foo bar] [r get foo] \
 188              [r append foo 100] [r get foo]
 189     } {3 bar 6 bar100}
 190
 191     test {APPEND basics, integer encoded values} {
 192         set res {}
 193         r del foo
 194         r append foo 1
 195         r append foo 2
 196         lappend res [r get foo]
 197         r set foo 1
 198         r append foo 2
 199         lappend res [r get foo]
 200     } {12 12}
 201
 202     test {APPEND fuzzing} {
 203         set err {}
 204         foreach type {binary alpha compr} {
 205             set buf {}
 206             r del x
 207             for {set i 0} {$i < 1000} {incr i} {
 208                 set bin [randstring 0 10 $type]
 209                 append buf $bin
 210                 r append x $bin
 211             }
 212             if {$buf != [r get x]} {
 213                 set err "Expected '$buf' found '[r get x]'"
 214                 break
 215             }
 216         }
 217         set _ $err
 218     } {}
 219
 220     test {SUBSTR basics} {
 221         set res {}
 222         r set foo "Hello World"
 223         lappend res [r substr foo 0 3]
 224         lappend res [r substr foo 0 -1]
 225         lappend res [r substr foo -4 -1]
 226         lappend res [r substr foo 5 3]
 227         lappend res [r substr foo 5 5000]
 228         lappend res [r substr foo -5000 10000]
 229         set _ $res
 230     } {Hell {Hello World} orld {} { World} {Hello World}}
 231
 232     test {SUBSTR against integer encoded values} {
 233         r set foo 123
 234         r substr foo 0 -2
 235     } {12}
 236
 237     test {SUBSTR fuzzing} {
 238         set err {}
 239         for {set i 0} {$i < 1000} {incr i} {
 240             set bin [randstring 0 1024 binary]
 241             set _start [set start [randomInt 1500]]
 242             set _end [set end [randomInt 1500]]
 243             if {$_start < 0} {set _start "end-[abs($_start)-1]"}
 244             if {$_end < 0} {set _end "end-[abs($_end)-1]"}
 245             set s1 [string range $bin $_start $_end]
 246             r set bin $bin
 247             set s2 [r substr bin $start $end]
 248             if {$s1 != $s2} {
 249                 set err "String mismatch"
 250                 break
 251             }
 252         }
 253         set _ $err
 254     } {}
 255
 256     # Leave the user with a clean DB before to exit
 257     test {FLUSHDB} {
 258         set aux {}
 259         r select 9
 260         r flushdb
 261         lappend aux [r dbsize]
 262         r select 10
 263         r flushdb
 264         lappend aux [r dbsize]
 265     } {0 0}
 266
 267     test {Perform a final SAVE to leave a clean DB on disk} {
 268         r save
 269     } {OK}
 270 }