blob: 5e89162368ac2fe3fd73cfbd2b27fed39a95986e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
set ::num_tests 0
set ::num_passed 0
set ::num_failed 0
set ::num_skipped 0
set ::num_aborted 0
set ::tests_failed {}
proc fail {msg} {
error "assertion:$msg"
}
proc assert {condition} {
if {![uplevel 1 [list expr $condition]]} {
set context "(context: [info frame -1])"
error "assertion:Expected [uplevel 1 [list subst -nocommands $condition]] $context"
}
}
proc assert_no_match {pattern value} {
if {[string match $pattern $value]} {
set context "(context: [info frame -1])"
error "assertion:Expected '$value' to not match '$pattern' $context"
}
}
proc assert_match {pattern value} {
if {![string match $pattern $value]} {
set context "(context: [info frame -1])"
error "assertion:Expected '$value' to match '$pattern' $context"
}
}
proc assert_equal {value expected {detail ""}} {
if {$expected ne $value} {
if {$detail ne ""} {
set detail "(detail: $detail)"
} else {
set detail "(context: [info frame -1])"
}
error "assertion:Expected '$value' to be equal to '$expected' $detail"
}
}
proc assert_lessthan {value expected {detail ""}} {
if {!($value < $expected)} {
if {$detail ne ""} {
set detail "(detail: $detail)"
} else {
set detail "(context: [info frame -1])"
}
error "assertion:Expected '$value' to be lessthan to '$expected' $detail"
}
}
proc assert_range {value min max {detail ""}} {
if {!($value <= $max && $value >= $min)} {
if {$detail ne ""} {
set detail "(detail: $detail)"
} else {
set detail "(context: [info frame -1])"
}
error "assertion:Expected '$value' to be between to '$min' and '$max' $detail"
}
}
proc assert_error {pattern code} {
if {[catch {uplevel 1 $code} error]} {
assert_match $pattern $error
} else {
error "assertion:Expected an error but nothing was caught"
}
}
proc assert_encoding {enc key} {
set dbg [r debug object $key]
assert_match "* encoding:$enc *" $dbg
}
proc assert_type {type key} {
assert_equal $type [r type $key]
}
# Wait for the specified condition to be true, with the specified number of
# max retries and delay between retries. Otherwise the 'elsescript' is
# executed.
proc wait_for_condition {maxtries delay e _else_ elsescript} {
while {[incr maxtries -1] >= 0} {
set errcode [catch {uplevel 1 [list expr $e]} result]
if {$errcode == 0} {
if {$result} break
} else {
return -code $errcode $result
}
after $delay
}
if {$maxtries == -1} {
set errcode [catch [uplevel 1 $elsescript] result]
return -code $errcode $result
}
}
proc test {name code {okpattern undefined}} {
# abort if tagged with a tag to deny
foreach tag $::denytags {
if {[lsearch $::tags $tag] >= 0} {
incr ::num_aborted
send_data_packet $::test_server_fd ignore $name
return
}
}
# abort if test name in skiptests
if {[lsearch $::skiptests $name] >= 0} {
incr ::num_skipped
send_data_packet $::test_server_fd skip $name
return
}
# abort if test name in skiptests
if {[llength $::only_tests] > 0 && [lsearch $::only_tests $name] < 0} {
incr ::num_skipped
send_data_packet $::test_server_fd skip $name
return
}
# check if tagged with at least 1 tag to allow when there *is* a list
# of tags to allow, because default policy is to run everything
if {[llength $::allowtags] > 0} {
set matched 0
foreach tag $::allowtags {
if {[lsearch $::tags $tag] >= 0} {
incr matched
}
}
if {$matched < 1} {
incr ::num_aborted
send_data_packet $::test_server_fd ignore $name
return
}
}
incr ::num_tests
set details {}
lappend details "$name in $::curfile"
send_data_packet $::test_server_fd testing $name
if {[catch {set retval [uplevel 1 $code]} error]} {
if {[string match "assertion:*" $error]} {
set msg [string range $error 10 end]
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
send_data_packet $::test_server_fd err [join $details "\n"]
} else {
# Re-raise, let handler up the stack take care of this.
error $error $::errorInfo
}
} else {
if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
incr ::num_passed
send_data_packet $::test_server_fd ok $name
} else {
set msg "Expected '$okpattern' to equal or match '$retval'"
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
send_data_packet $::test_server_fd err [join $details "\n"]
}
}
if {$::traceleaks} {
set output [exec leaks redis-server]
if {![string match {*0 leaks*} $output]} {
send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
}
}
}
|
