]>
git.saurik.com Git - redis.git/blob - tests/test_helper.tcl
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
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
18 set ::external 0; # If "1" this means, we are running against external instance
19 set ::file ""; # If set, runs only the tests in this comma separated list
21 proc execute_tests name
{
22 source "tests/$name.tcl"
25 # Setup a list to hold a stack of server configs. When calls to start_server
26 # are nested, use "srv 0 pid" to get the pid of the inner server. To access
27 # outer servers, use "srv -1 pid" etcetera.
31 if {[string is integer
[lindex $args 0]]} {
32 set level
[lindex $args 0]
33 set property
[lindex $args 1]
35 set property
[lindex $args 0]
37 set srv
[lindex $::servers end
+$level]
38 dict get
$srv $property
41 # Provide easy access to the client for the inner server. It's possible to
42 # prepend the argument list with a negative level to access clients for
43 # servers running in outer blocks.
46 if {[string is integer
[lindex $args 0]]} {
47 set level
[lindex $args 0]
48 set args
[lrange $args 1 end
]
50 [srv
$level "client"] {*}$args
53 proc reconnect
{args
} {
54 set level
[lindex $args 0]
55 if {[string length
$level] == 0 ||
![string is integer
$level]} {
59 set srv
[lindex $::servers end
+$level]
60 set host
[dict get
$srv "host"]
61 set port
[dict get
$srv "port"]
62 set config
[dict get
$srv "config"]
63 set client
[redis
$host $port]
64 dict
set srv
"client" $client
66 # select the right db when we don't have to authenticate
67 if {![dict exists
$config "requirepass"]} {
71 # re-set $srv in the servers list
72 set ::servers [lreplace $::servers end
+$level 1 $srv]
75 proc redis_deferring_client
{args
} {
77 if {[llength $args] > 0 && [string is integer
[lindex $args 0]]} {
78 set level
[lindex $args 0]
79 set args
[lrange $args 1 end
]
82 # create client that defers reading reply
83 set client
[redis
[srv
$level "host"] [srv
$level "port"] 1]
85 # select the right db and read the response (OK)
91 # Provide easy access to INFO properties. Same semantic as "proc r".
94 if {[string is integer
[lindex $args 0]]} {
95 set level
[lindex $args 0]
96 set args
[lrange $args 1 end
]
98 status
[srv
$level "client"] [lindex $args 0]
102 catch {exec rm
-rf {*}[glob tests
/tmp
/redis.conf.
*]}
103 catch {exec rm
-rf {*}[glob tests
/tmp
/server.
*]}
106 proc execute_everything
{} {
107 execute_tests
"unit/auth"
108 execute_tests
"unit/protocol"
109 execute_tests
"unit/basic"
110 execute_tests
"unit/type/list"
111 execute_tests
"unit/type/set"
112 execute_tests
"unit/type/zset"
113 execute_tests
"unit/type/hash"
114 execute_tests
"unit/sort"
115 execute_tests
"unit/expire"
116 execute_tests
"unit/other"
117 execute_tests
"unit/cas"
118 execute_tests
"unit/quit"
119 execute_tests
"integration/replication"
120 execute_tests
"integration/aof"
121 # execute_tests "integration/redis-cli"
122 execute_tests
"unit/pubsub"
124 # run tests with VM enabled
125 set ::global_overrides {vm-enabled yes
}
126 execute_tests
"unit/protocol"
127 execute_tests
"unit/basic"
128 execute_tests
"unit/type/list"
129 execute_tests
"unit/type/set"
130 execute_tests
"unit/type/zset"
131 execute_tests
"unit/type/hash"
132 execute_tests
"unit/sort"
133 execute_tests
"unit/expire"
134 execute_tests
"unit/other"
135 execute_tests
"unit/cas"
141 if {[string length
$::file] > 0} {
142 foreach {file} [split $::file ,] {
150 puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
152 puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
158 for {set j
0} {$j < [llength $argv]} {incr j
} {
159 set opt
[lindex $argv $j]
160 set arg
[lindex $argv [expr $j+1]]
161 if {$opt eq
{--tags}} {
163 if {[string index
$tag 0] eq
"-"} {
164 lappend ::denytags [string range
$tag 1 end
]
166 lappend ::allowtags $tag
170 } elseif
{$opt eq
{--file}} {
173 } elseif
{$opt eq
{--host}} {
177 } elseif
{$opt eq
{--port}} {
181 puts "Wrong argument: $opt"
186 if {[catch { main
} err
]} {
187 if {[string length
$err] > 0} {
188 # only display error when not generated by the test suite
189 if {$err ne
"exception"} {