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