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