tests/support/util.tcl

   1 proc randstring {min max {type binary}} {
   2     set len [expr {$min+int(rand()*($max-$min+1))}]
   3     set output {}
   4     if {$type eq {binary}} {
   5         set minval 0
   6         set maxval 255
   7     } elseif {$type eq {alpha}} {
   8         set minval 48
   9         set maxval 122
  10     } elseif {$type eq {compr}} {
  11         set minval 48
  12         set maxval 52
  13     }
  14     while {$len} {
  15         append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
  16         incr len -1
  17     }
  18     return $output
  19 }
  20
  21 # Useful for some test
  22 proc zlistAlikeSort {a b} {
  23     if {[lindex $a 0] > [lindex $b 0]} {return 1}
  24     if {[lindex $a 0] < [lindex $b 0]} {return -1}
  25     string compare [lindex $a 1] [lindex $b 1]
  26 }
  27
  28 # Return value for INFO property
  29 proc status {r property} {
  30     if {[regexp "\r\n$property:(.*?)\r\n" [$r info] _ value]} {
  31         set _ $value
  32     }
  33 }
  34
  35 proc waitForBgsave r {
  36     while 1 {
  37         if {[status r bgsave_in_progress] eq 1} {
  38             puts -nonewline "\nWaiting for background save to finish... "
  39             flush stdout
  40             after 1000
  41         } else {
  42             break
  43         }
  44     }
  45 }
  46
  47 proc waitForBgrewriteaof r {
  48     while 1 {
  49         if {[status r bgrewriteaof_in_progress] eq 1} {
  50             puts -nonewline "\nWaiting for background AOF rewrite to finish... "
  51             flush stdout
  52             after 1000
  53         } else {
  54             break
  55         }
  56     }
  57 }
  58
  59 proc wait_for_sync r {
  60     while 1 {
  61         if {[status r master_link_status] eq "down"} {
  62             after 10
  63         } else {
  64             break
  65         }
  66     }
  67 }
  68
  69 proc randomInt {max} {
  70     expr {int(rand()*$max)}
  71 }
  72
  73 proc randpath args {
  74     set path [expr {int(rand()*[llength $args])}]
  75     uplevel 1 [lindex $args $path]
  76 }
  77
  78 proc randomValue {} {
  79     randpath {
  80         # Small enough to likely collide
  81         randomInt 1000
  82     } {
  83         # 32 bit compressible signed/unsigned
  84         randpath {randomInt 2000000000} {randomInt 4000000000}
  85     } {
  86         # 64 bit
  87         randpath {randomInt 1000000000000}
  88     } {
  89         # Random string
  90         randpath {randstring 0 256 alpha} \
  91                 {randstring 0 256 compr} \
  92                 {randstring 0 256 binary}
  93     }
  94 }
  95
  96 proc randomKey {} {
  97     randpath {
  98         # Small enough to likely collide
  99         randomInt 1000
 100     } {
 101         # 32 bit compressible signed/unsigned
 102         randpath {randomInt 2000000000} {randomInt 4000000000}
 103     } {
 104         # 64 bit
 105         randpath {randomInt 1000000000000}
 106     } {
 107         # Random string
 108         randpath {randstring 1 256 alpha} \
 109                 {randstring 1 256 compr}
 110     }
 111 }
 112
 113 proc createComplexDataset {r ops} {
 114     for {set j 0} {$j < $ops} {incr j} {
 115         set k [randomKey]
 116         set f [randomValue]
 117         set v [randomValue]
 118         randpath {
 119             set d [expr {rand()}]
 120         } {
 121             set d [expr {rand()}]
 122         } {
 123             set d [expr {rand()}]
 124         } {
 125             set d [expr {rand()}]
 126         } {
 127             set d [expr {rand()}]
 128         } {
 129             randpath {set d +inf} {set d -inf}
 130         }
 131         set t [$r type $k]
 132
 133         if {$t eq {none}} {
 134             randpath {
 135                 $r set $k $v
 136             } {
 137                 $r lpush $k $v
 138             } {
 139                 $r sadd $k $v
 140             } {
 141                 $r zadd $k $d $v
 142             } {
 143                 $r hset $k $f $v
 144             }
 145             set t [$r type $k]
 146         }
 147
 148         switch $t {
 149             {string} {
 150                 # Nothing to do
 151             }
 152             {list} {
 153                 randpath {$r lpush $k $v} \
 154                         {$r rpush $k $v} \
 155                         {$r lrem $k 0 $v} \
 156                         {$r rpop $k} \
 157                         {$r lpop $k}
 158             }
 159             {set} {
 160                 randpath {$r sadd $k $v} \
 161                         {$r srem $k $v}
 162             }
 163             {zset} {
 164                 randpath {$r zadd $k $d $v} \
 165                         {$r zrem $k $v}
 166             }
 167             {hash} {
 168                 randpath {$r hset $k $f $v} \
 169                         {$r hdel $k $f}
 170             }
 171         }
 172     }
 173 }