blob: 7d390cc47ad896820a14a4115660d05b116054ea (
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
|
set ::num_tests 0
set ::num_passed 0
set ::num_failed 0
set ::tests_failed {}
proc fail {msg} {
error "assertion:$msg"
}
proc assert {condition} {
if {![uplevel 1 [list expr $condition]]} {
error "assertion:Expected condition '$condition' to be true ([uplevel 1 [list subst -nocommands $condition]])"
}
}
proc assert_match {pattern value} {
if {![string match $pattern $value]} {
error "assertion:Expected '$value' to match '$pattern'"
}
}
proc assert_equal {expected value} {
if {$expected ne $value} {
error "assertion:Expected '$value' to be equal to '$expected'"
}
}
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} {
# Swapped out values don't have an encoding, so make sure that
# the value is swapped in before checking the encoding.
set dbg [r debug object $key]
while {[string match "* swapped at:*" $dbg]} {
r debug swapin $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} {
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} {
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"
}
}
}
|
