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 {APPEND basics} {
 135         list [r append foo bar] [r get foo] \
 136              [r append foo 100] [r get foo]
 137     } {3 bar 6 bar100}
 138
 139     test {APPEND basics, integer encoded values} {
 140         set res {}
 141         r del foo
 142         r append foo 1
 143         r append foo 2
 144         lappend res [r get foo]
 145         r set foo 1
 146         r append foo 2
 147         lappend res [r get foo]
 148     } {12 12}
 149
 150     test {APPEND fuzzing} {
 151         set err {}
 152         foreach type {binary alpha compr} {
 153             set buf {}
 154             r del x
 155             for {set i 0} {$i < 1000} {incr i} {
 156                 set bin [randstring 0 10 $type]
 157                 append buf $bin
 158                 r append x $bin
 159             }
 160             if {$buf != [r get x]} {
 161                 set err "Expected '$buf' found '[r get x]'"
 162                 break
 163             }
 164         }
 165         set _ $err
 166     } {}
 167
 168     test {SUBSTR basics} {
 169         set res {}
 170         r set foo "Hello World"
 171         lappend res [r substr foo 0 3]
 172         lappend res [r substr foo 0 -1]
 173         lappend res [r substr foo -4 -1]
 174         lappend res [r substr foo 5 3]
 175         lappend res [r substr foo 5 5000]
 176         lappend res [r substr foo -5000 10000]
 177         set _ $res
 178     } {Hell {Hello World} orld {} { World} {Hello World}}
 179
 180     test {SUBSTR against integer encoded values} {
 181         r set foo 123
 182         r substr foo 0 -2
 183     } {12}
 184
 185     test {SUBSTR fuzzing} {
 186         set err {}
 187         for {set i 0} {$i < 1000} {incr i} {
 188             set bin [randstring 0 1024 binary]
 189             set _start [set start [randomInt 1500]]
 190             set _end [set end [randomInt 1500]]
 191             if {$_start < 0} {set _start "end-[abs($_start)-1]"}
 192             if {$_end < 0} {set _end "end-[abs($_end)-1]"}
 193             set s1 [string range $bin $_start $_end]
 194             r set bin $bin
 195             set s2 [r substr bin $start $end]
 196             if {$s1 != $s2} {
 197                 set err "String mismatch"
 198                 break
 199             }
 200         }
 201         set _ $err
 202     } {}
 203
 204     # Leave the user with a clean DB before to exit
 205     test {FLUSHDB} {
 206         set aux {}
 207         r select 9
 208         r flushdb
 209         lappend aux [r dbsize]
 210         r select 10
 211         r flushdb
 212         lappend aux [r dbsize]
 213     } {0 0}
 214
 215     test {Perform a final SAVE to leave a clean DB on disk} {
 216         r save
 217     } {OK}
 218 }