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 all log lines starting with the first line that contains a warning.
  29 # Generally, this will be an assertion error with a stack trace.
  30 proc warnings_from_file {filename} {
  31     set lines [split [exec cat $filename] "\n"]
  32     set matched 0
  33     set result {}
  34     foreach line $lines {
  35         if {[regexp {^\[\d+\]\s+\d+\s+\w+\s+\d{2}:\d{2}:\d{2} \#} $line]} {
  36             set matched 1
  37         }
  38         if {$matched} {
  39             lappend result $line
  40         }
  41     }
  42     join $result "\n"
  43 }
  44
  45 # Return value for INFO property
  46 proc status {r property} {
  47     if {[regexp "\r\n$property:(.*?)\r\n" [$r info] _ value]} {
  48         set _ $value
  49     }
  50 }
  51
  52 proc waitForBgsave r {
  53     while 1 {
  54         if {[status r bgsave_in_progress] eq 1} {
  55             puts -nonewline "\nWaiting for background save to finish... "
  56             flush stdout
  57             after 1000
  58         } else {
  59             break
  60         }
  61     }
  62 }
  63
  64 proc waitForBgrewriteaof r {
  65     while 1 {
  66         if {[status r bgrewriteaof_in_progress] eq 1} {
  67             puts -nonewline "\nWaiting for background AOF rewrite to finish... "
  68             flush stdout
  69             after 1000
  70         } else {
  71             break
  72         }
  73     }
  74 }
  75
  76 proc wait_for_sync r {
  77     while 1 {
  78         if {[status r master_link_status] eq "down"} {
  79             after 10
  80         } else {
  81             break
  82         }
  83     }
  84 }
  85
  86 proc randomInt {max} {
  87     expr {int(rand()*$max)}
  88 }
  89
  90 proc randpath args {
  91     set path [expr {int(rand()*[llength $args])}]
  92     uplevel 1 [lindex $args $path]
  93 }
  94
  95 proc randomValue {} {
  96     randpath {
  97         # Small enough to likely collide
  98         randomInt 1000
  99     } {
 100         # 32 bit compressible signed/unsigned
 101         randpath {randomInt 2000000000} {randomInt 4000000000}
 102     } {
 103         # 64 bit
 104         randpath {randomInt 1000000000000}
 105     } {
 106         # Random string
 107         randpath {randstring 0 256 alpha} \
 108                 {randstring 0 256 compr} \
 109                 {randstring 0 256 binary}
 110     }
 111 }
 112
 113 proc randomKey {} {
 114     randpath {
 115         # Small enough to likely collide
 116         randomInt 1000
 117     } {
 118         # 32 bit compressible signed/unsigned
 119         randpath {randomInt 2000000000} {randomInt 4000000000}
 120     } {
 121         # 64 bit
 122         randpath {randomInt 1000000000000}
 123     } {
 124         # Random string
 125         randpath {randstring 1 256 alpha} \
 126                 {randstring 1 256 compr}
 127     }
 128 }
 129
 130 proc createComplexDataset {r ops} {
 131     for {set j 0} {$j < $ops} {incr j} {
 132         set k [randomKey]
 133         set f [randomValue]
 134         set v [randomValue]
 135         randpath {
 136             set d [expr {rand()}]
 137         } {
 138             set d [expr {rand()}]
 139         } {
 140             set d [expr {rand()}]
 141         } {
 142             set d [expr {rand()}]
 143         } {
 144             set d [expr {rand()}]
 145         } {
 146             randpath {set d +inf} {set d -inf}
 147         }
 148         set t [$r type $k]
 149
 150         if {$t eq {none}} {
 151             randpath {
 152                 $r set $k $v
 153             } {
 154                 $r lpush $k $v
 155             } {
 156                 $r sadd $k $v
 157             } {
 158                 $r zadd $k $d $v
 159             } {
 160                 $r hset $k $f $v
 161             }
 162             set t [$r type $k]
 163         }
 164
 165         switch $t {
 166             {string} {
 167                 # Nothing to do
 168             }
 169             {list} {
 170                 randpath {$r lpush $k $v} \
 171                         {$r rpush $k $v} \
 172                         {$r lrem $k 0 $v} \
 173                         {$r rpop $k} \
 174                         {$r lpop $k}
 175             }
 176             {set} {
 177                 randpath {$r sadd $k $v} \
 178                         {$r srem $k $v}
 179             }
 180             {zset} {
 181                 randpath {$r zadd $k $d $v} \
 182                         {$r zrem $k $v}
 183             }
 184             {hash} {
 185                 randpath {$r hset $k $f $v} \
 186                         {$r hdel $k $f}
 187             }
 188         }
 189     }
 190 }
 191
 192 proc formatCommand {args} {
 193     set cmd "*[llength $args]\r\n"
 194     foreach a $args {
 195         append cmd "$[string length $a]\r\n$a\r\n"
 196     }
 197     set _ $cmd
 198 }