]>
Commit | Line | Data |
---|---|---|
98578b57 PN |
1 | # Redis test suite. Copyright (C) 2009 Salvatore Sanfilippo antirez@gmail.com |
2 | # This softare is released under the BSD License. See the COPYING file for | |
3 | # more information. | |
4 | ||
5 | set tcl_precision 17 | |
ab72b483 | 6 | source tests/support/redis.tcl |
7 | source tests/support/server.tcl | |
8 | source tests/support/tmpfile.tcl | |
9 | source tests/support/test.tcl | |
10 | source tests/support/util.tcl | |
98578b57 PN |
11 | |
12 | set ::host 127.0.0.1 | |
47bebf15 | 13 | set ::port 16379 |
98578b57 | 14 | set ::traceleaks 0 |
c4669d25 | 15 | set ::valgrind 0 |
6e0e5bed PN |
16 | set ::denytags {} |
17 | set ::allowtags {} | |
98578b57 PN |
18 | |
19 | proc execute_tests name { | |
ab72b483 | 20 | source "tests/$name.tcl" |
98578b57 PN |
21 | } |
22 | ||
1c4114be PN |
23 | # Setup a list to hold a stack of server configs. When calls to start_server |
24 | # are nested, use "srv 0 pid" to get the pid of the inner server. To access | |
25 | # outer servers, use "srv -1 pid" etcetera. | |
26 | set ::servers {} | |
27 | proc srv {level property} { | |
28 | set srv [lindex $::servers end+$level] | |
29 | dict get $srv $property | |
30 | } | |
31 | ||
32 | # Provide easy access to the client for the inner server. It's possible to | |
33 | # prepend the argument list with a negative level to access clients for | |
34 | # servers running in outer blocks. | |
98578b57 | 35 | proc r {args} { |
1c4114be PN |
36 | set level 0 |
37 | if {[string is integer [lindex $args 0]]} { | |
38 | set level [lindex $args 0] | |
39 | set args [lrange $args 1 end] | |
40 | } | |
41 | [srv $level "client"] {*}$args | |
42 | } | |
43 | ||
44 | # Provide easy access to INFO properties. Same semantic as "proc r". | |
45 | proc s {args} { | |
46 | set level 0 | |
47 | if {[string is integer [lindex $args 0]]} { | |
48 | set level [lindex $args 0] | |
49 | set args [lrange $args 1 end] | |
50 | } | |
51 | status [srv $level "client"] [lindex $args 0] | |
98578b57 PN |
52 | } |
53 | ||
f166bb1d | 54 | proc cleanup {} { |
c4669d25 | 55 | catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]} |
56 | catch {exec rm -rf {*}[glob tests/tmp/server.*]} | |
f166bb1d PN |
57 | } |
58 | ||
98578b57 | 59 | proc main {} { |
f166bb1d | 60 | cleanup |
98578b57 PN |
61 | execute_tests "unit/auth" |
62 | execute_tests "unit/protocol" | |
63 | execute_tests "unit/basic" | |
64 | execute_tests "unit/type/list" | |
65 | execute_tests "unit/type/set" | |
66 | execute_tests "unit/type/zset" | |
67 | execute_tests "unit/type/hash" | |
68 | execute_tests "unit/sort" | |
69 | execute_tests "unit/expire" | |
70 | execute_tests "unit/other" | |
c20c189d | 71 | execute_tests "unit/cas" |
85ecc65e | 72 | execute_tests "integration/replication" |
53cbf66c | 73 | execute_tests "integration/aof" |
f166bb1d PN |
74 | |
75 | # run tests with VM enabled | |
76 | set ::global_overrides [list [list vm-enabled yes]] | |
77 | execute_tests "unit/protocol" | |
78 | execute_tests "unit/basic" | |
79 | execute_tests "unit/type/list" | |
80 | execute_tests "unit/type/set" | |
81 | execute_tests "unit/type/zset" | |
82 | execute_tests "unit/type/hash" | |
83 | execute_tests "unit/sort" | |
84 | execute_tests "unit/expire" | |
85 | execute_tests "unit/other" | |
c20c189d | 86 | execute_tests "unit/cas" |
98578b57 PN |
87 | |
88 | puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed" | |
89 | if {$::failed > 0} { | |
90 | puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n" | |
91 | } | |
f166bb1d PN |
92 | |
93 | cleanup | |
98578b57 PN |
94 | } |
95 | ||
73bd6c58 PN |
96 | # parse arguments |
97 | for {set j 0} {$j < [llength $argv]} {incr j} { | |
98 | set opt [lindex $argv $j] | |
99 | set arg [lindex $argv [expr $j+1]] | |
100 | if {$opt eq {--tags}} { | |
101 | foreach tag $arg { | |
102 | if {[string index $tag 0] eq "-"} { | |
103 | lappend ::denytags [string range $tag 1 end] | |
104 | } else { | |
105 | lappend ::allowtags $tag | |
106 | } | |
107 | } | |
108 | incr j | |
109 | } else { | |
110 | puts "Wrong argument: $opt" | |
111 | exit 1 | |
112 | } | |
113 | } | |
114 | ||
436f18b6 PN |
115 | if {[catch { main } err]} { |
116 | if {[string length $err] > 0} { | |
117 | # only display error when not generated by the test suite | |
118 | if {$err ne "exception"} { | |
119 | puts $err | |
120 | } | |
121 | exit 1 | |
122 | } | |
123 | } |