tests/unit/other.tcl

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