xref: /redis-3.2.3/tests/support/util.tcl (revision 414c3dea)
1proc 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
22proc 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.
30proc 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
46proc status {r property} {
47    if {[regexp "\r\n$property:(.*?)\r\n" [{*}$r info] _ value]} {
48        set _ $value
49    }
50}
51
52proc 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
66proc 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
80proc 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
90proc randomInt {max} {
91    expr {int(rand()*$max)}
92}
93
94proc randpath args {
95    set path [expr {int(rand()*[llength $args])}]
96    uplevel 1 [lindex $args $path]
97}
98
99proc 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
117proc 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
134proc 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
147proc 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
241proc 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
249proc 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
294proc csvstring s {
295    return "\"$s\""
296}
297
298proc roundFloat f {
299    format "%.10g" $f
300}
301