xref: /redis-3.2.3/tests/support/util.tcl (revision f166bb1d) 
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            puts -nonewline "\nWaiting for background save to finish... "
56            flush stdout
57            after 1000
58        } else {
59            break
60        }
61    }
62}
63
64proc 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
76proc 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
86proc randomInt {max} {
87    expr {int(rand()*$max)}
88}
89
90proc randpath args {
91    set path [expr {int(rand()*[llength $args])}]
92    uplevel 1 [lindex $args $path]
93}
94
95proc 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
113proc 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
130proc 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
192proc 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}
199