]> git.saurik.com Git - redis.git/blob - tests/support/test.tcl
Redis test: More reliable BRPOPLPUSH replication test.
[redis.git] / tests / support / test.tcl
1 set ::num_tests 0
2 set ::num_passed 0
3 set ::num_failed 0
4 set ::tests_failed {}
5
6 proc fail {msg} {
7 error "assertion:$msg"
8 }
9
10 proc assert {condition} {
11 if {![uplevel 1 [list expr $condition]]} {
12 error "assertion:Expected condition '$condition' to be true ([uplevel 1 [list subst -nocommands $condition]])"
13 }
14 }
15
16 proc assert_match {pattern value} {
17 if {![string match $pattern $value]} {
18 error "assertion:Expected '$value' to match '$pattern'"
19 }
20 }
21
22 proc assert_equal {expected value} {
23 if {$expected ne $value} {
24 error "assertion:Expected '$value' to be equal to '$expected'"
25 }
26 }
27
28 proc assert_error {pattern code} {
29 if {[catch {uplevel 1 $code} error]} {
30 assert_match $pattern $error
31 } else {
32 error "assertion:Expected an error but nothing was catched"
33 }
34 }
35
36 proc assert_encoding {enc key} {
37 # Swapped out values don't have an encoding, so make sure that
38 # the value is swapped in before checking the encoding.
39 set dbg [r debug object $key]
40 while {[string match "* swapped at:*" $dbg]} {
41 r debug swapin $key
42 set dbg [r debug object $key]
43 }
44 assert_match "* encoding:$enc *" $dbg
45 }
46
47 proc assert_type {type key} {
48 assert_equal $type [r type $key]
49 }
50
51 # Wait for the specified condition to be true, with the specified number of
52 # max retries and delay between retries. Otherwise the 'elsescript' is
53 # executed.
54 proc wait_for_condition {maxtries delay e _else_ elsescript} {
55 while {[incr maxtries -1] >= 0} {
56 if {[uplevel 1 [list expr $e]]} break
57 after $delay
58 }
59 if {$maxtries == -1} {
60 uplevel 1 $elsescript
61 }
62 }
63
64 # Test if TERM looks like to support colors
65 proc color_term {} {
66 expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
67 }
68
69 proc colorstr {color str} {
70 if {[color_term]} {
71 set b 0
72 if {[string range $color 0 4] eq {bold-}} {
73 set b 1
74 set color [string range $color 5 end]
75 }
76 switch $color {
77 red {set colorcode {31}}
78 green {set colorcode {32}}
79 yellow {set colorcode {33}}
80 blue {set colorcode {34}}
81 magenta {set colorcode {35}}
82 cyan {set colorcode {36}}
83 white {set colorcode {37}}
84 default {set colorcode {37}}
85 }
86 if {$colorcode ne {}} {
87 return "\033\[$b;${colorcode};40m$str\033\[0m"
88 }
89 } else {
90 return $str
91 }
92 }
93
94 proc test {name code {okpattern undefined}} {
95 # abort if tagged with a tag to deny
96 foreach tag $::denytags {
97 if {[lsearch $::tags $tag] >= 0} {
98 return
99 }
100 }
101
102 # check if tagged with at least 1 tag to allow when there *is* a list
103 # of tags to allow, because default policy is to run everything
104 if {[llength $::allowtags] > 0} {
105 set matched 0
106 foreach tag $::allowtags {
107 if {[lsearch $::tags $tag] >= 0} {
108 incr matched
109 }
110 }
111 if {$matched < 1} {
112 return
113 }
114 }
115
116 incr ::num_tests
117 set details {}
118 lappend details "$name in $::curfile"
119
120 send_data_packet $::test_server_fd testing $name
121
122 if {[catch {set retval [uplevel 1 $code]} error]} {
123 if {[string match "assertion:*" $error]} {
124 set msg [string range $error 10 end]
125 lappend details $msg
126 lappend ::tests_failed $details
127
128 incr ::num_failed
129 send_data_packet $::test_server_fd err [join $details "\n"]
130 } else {
131 # Re-raise, let handler up the stack take care of this.
132 error $error $::errorInfo
133 }
134 } else {
135 if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
136 incr ::num_passed
137 send_data_packet $::test_server_fd ok $name
138 } else {
139 set msg "Expected '$okpattern' to equal or match '$retval'"
140 lappend details $msg
141 lappend ::tests_failed $details
142
143 incr ::num_failed
144 send_data_packet $::test_server_fd err [join $details "\n"]
145 }
146 }
147
148 if {$::traceleaks} {
149 set output [exec leaks redis-server]
150 if {![string match {*0 leaks*} $output]} {
151 send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
152 }
153 }
154 }