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