]> git.saurik.com Git - redis.git/blob - tests/support/util.tcl
Redis 2.5.9 (2.6 RC3).
[redis.git] / 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 if {$::verbose} {
56 puts -nonewline "\nWaiting for background save to finish... "
57 flush stdout
58 }
59 after 1000
60 } else {
61 break
62 }
63 }
64 }
65
66 proc waitForBgrewriteaof r {
67 while 1 {
68 if {[status r bgrewriteaof_in_progress] eq 1} {
69 if {$::verbose} {
70 puts -nonewline "\nWaiting for background AOF rewrite to finish... "
71 flush stdout
72 }
73 after 1000
74 } else {
75 break
76 }
77 }
78 }
79
80 proc wait_for_sync r {
81 while 1 {
82 if {[status r master_link_status] eq "down"} {
83 after 10
84 } else {
85 break
86 }
87 }
88 }
89
90 proc randomInt {max} {
91 expr {int(rand()*$max)}
92 }
93
94 proc randpath args {
95 set path [expr {int(rand()*[llength $args])}]
96 uplevel 1 [lindex $args $path]
97 }
98
99 proc randomValue {} {
100 randpath {
101 # Small enough to likely collide
102 randomInt 1000
103 } {
104 # 32 bit compressible signed/unsigned
105 randpath {randomInt 2000000000} {randomInt 4000000000}
106 } {
107 # 64 bit
108 randpath {randomInt 1000000000000}
109 } {
110 # Random string
111 randpath {randstring 0 256 alpha} \
112 {randstring 0 256 compr} \
113 {randstring 0 256 binary}
114 }
115 }
116
117 proc randomKey {} {
118 randpath {
119 # Small enough to likely collide
120 randomInt 1000
121 } {
122 # 32 bit compressible signed/unsigned
123 randpath {randomInt 2000000000} {randomInt 4000000000}
124 } {
125 # 64 bit
126 randpath {randomInt 1000000000000}
127 } {
128 # Random string
129 randpath {randstring 1 256 alpha} \
130 {randstring 1 256 compr}
131 }
132 }
133
134 proc findKeyWithType {r type} {
135 for {set j 0} {$j < 20} {incr j} {
136 set k [{*}$r randomkey]
137 if {$k eq {}} {
138 return {}
139 }
140 if {[{*}$r type $k] eq $type} {
141 return $k
142 }
143 }
144 return {}
145 }
146
147 proc createComplexDataset {r ops {opt {}}} {
148 for {set j 0} {$j < $ops} {incr j} {
149 set k [randomKey]
150 set k2 [randomKey]
151 set f [randomValue]
152 set v [randomValue]
153
154 if {[lsearch -exact $opt useexpire] != -1} {
155 if {rand() < 0.1} {
156 {*}$r expire [randomKey] [randomInt 2]
157 }
158 }
159
160 randpath {
161 set d [expr {rand()}]
162 } {
163 set d [expr {rand()}]
164 } {
165 set d [expr {rand()}]
166 } {
167 set d [expr {rand()}]
168 } {
169 set d [expr {rand()}]
170 } {
171 randpath {set d +inf} {set d -inf}
172 }
173 set t [{*}$r type $k]
174
175 if {$t eq {none}} {
176 randpath {
177 {*}$r set $k $v
178 } {
179 {*}$r lpush $k $v
180 } {
181 {*}$r sadd $k $v
182 } {
183 {*}$r zadd $k $d $v
184 } {
185 {*}$r hset $k $f $v
186 } {
187 {*}$r del $k
188 }
189 set t [{*}$r type $k]
190 }
191
192 switch $t {
193 {string} {
194 # Nothing to do
195 }
196 {list} {
197 randpath {{*}$r lpush $k $v} \
198 {{*}$r rpush $k $v} \
199 {{*}$r lrem $k 0 $v} \
200 {{*}$r rpop $k} \
201 {{*}$r lpop $k}
202 }
203 {set} {
204 randpath {{*}$r sadd $k $v} \
205 {{*}$r srem $k $v} \
206 {
207 set otherset [findKeyWithType {*}$r set]
208 if {$otherset ne {}} {
209 randpath {
210 {*}$r sunionstore $k2 $k $otherset
211 } {
212 {*}$r sinterstore $k2 $k $otherset
213 } {
214 {*}$r sdiffstore $k2 $k $otherset
215 }
216 }
217 }
218 }
219 {zset} {
220 randpath {{*}$r zadd $k $d $v} \
221 {{*}$r zrem $k $v} \
222 {
223 set otherzset [findKeyWithType {*}$r zset]
224 if {$otherzset ne {}} {
225 randpath {
226 {*}$r zunionstore $k2 2 $k $otherzset
227 } {
228 {*}$r zinterstore $k2 2 $k $otherzset
229 }
230 }
231 }
232 }
233 {hash} {
234 randpath {{*}$r hset $k $f $v} \
235 {{*}$r hdel $k $f}
236 }
237 }
238 }
239 }
240
241 proc formatCommand {args} {
242 set cmd "*[llength $args]\r\n"
243 foreach a $args {
244 append cmd "$[string length $a]\r\n$a\r\n"
245 }
246 set _ $cmd
247 }
248
249 proc csvdump r {
250 set o {}
251 foreach k [lsort [{*}$r keys *]] {
252 set type [{*}$r type $k]
253 append o [csvstring $k] , [csvstring $type] ,
254 switch $type {
255 string {
256 append o [csvstring [{*}$r get $k]] "\n"
257 }
258 list {
259 foreach e [{*}$r lrange $k 0 -1] {
260 append o [csvstring $e] ,
261 }
262 append o "\n"
263 }
264 set {
265 foreach e [lsort [{*}$r smembers $k]] {
266 append o [csvstring $e] ,
267 }
268 append o "\n"
269 }
270 zset {
271 foreach e [{*}$r zrange $k 0 -1 withscores] {
272 append o [csvstring $e] ,
273 }
274 append o "\n"
275 }
276 hash {
277 set fields [{*}$r hgetall $k]
278 set newfields {}
279 foreach {k v} $fields {
280 lappend newfields [list $k $v]
281 }
282 set fields [lsort -index 0 $newfields]
283 foreach kv $fields {
284 append o [csvstring [lindex $kv 0]] ,
285 append o [csvstring [lindex $kv 1]] ,
286 }
287 append o "\n"
288 }
289 }
290 }
291 return $o
292 }
293
294 proc csvstring s {
295 return "\"$s\""
296 }
297
298 proc roundFloat f {
299 format "%.10g" $f
300 }