Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
ruanhaishen
redis
Commits
6e0e5bed
Commit
6e0e5bed
authored
Jun 02, 2010
by
Pieter Noordhuis
Browse files
basic support to tag tests
parent
9e5d2e8b
Changes
4
Hide whitespace changes
Inline
Side-by-side
tests/support/server.tcl
View file @
6e0e5bed
set ::global_overrides
{}
set ::tags
{}
proc error_and_quit
{
config_file error
}
{
puts
"!!COULD NOT START REDIS-SERVER
\n
"
puts
"CONFIGURATION:"
...
...
@@ -80,18 +83,31 @@ proc ping_server {host port} {
return $retval
}
set ::global_overrides
{}
# doesn't really belong here, but highly coupled to code in start_server
proc tags
{
tags code
}
{
set ::tags
[
concat $::tags $tags
]
uplevel 1 $code
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
}
proc start_server
{
options
{
code undefined
}}
{
# setup defaults
set baseconfig
"default.conf"
set overrides
{}
set tags
{}
# parse options
foreach
{
option value
}
$options
{
switch $option
{
"config"
{
set baseconfig $value
}
"overrides"
{
set overrides $value
}
default
{
error
"Unknown option
$option
"
}
"config"
{
set baseconfig $value
}
"overrides"
{
set overrides $value
}
"tags"
{
set tags $value
set ::tags
[
concat $::tags $value
]
}
default
{
error
"Unknown option
$option
"
}
}
}
...
...
@@ -190,7 +206,12 @@ proc start_server {options {code undefined}} {
lappend ::servers $srv
# execute provided block
set curnum $::testnum
catch
{
uplevel 1 $code
}
err
if
{
$curnum
== $::testnum
}
{
# don't check for leaks when no tests were executed
dict set srv
"skipleaks"
1
}
# pop the server object
set ::servers
[
lrange $::servers 0 end-1
]
...
...
@@ -219,4 +240,7 @@ proc start_server {options {code undefined}} {
}
else
{
set _ $srv
}
# remove tags
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
}
tests/support/test.tcl
View file @
6e0e5bed
...
...
@@ -3,6 +3,27 @@ set ::failed 0
set ::testnum 0
proc test
{
name code okpattern
}
{
# 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
]}
{
incr matched
}
}
if
{
$matched
< 1
}
{
return
}
}
incr ::testnum
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
flush stdout
...
...
tests/test_helper.tcl
View file @
6e0e5bed
...
...
@@ -13,6 +13,8 @@ set ::host 127.0.0.1
set ::port 16379
set ::traceleaks 0
set ::valgrind 0
set ::denytags
{}
set ::allowtags
{}
proc execute_tests name
{
source
"tests/
$name.tcl
"
...
...
tests/unit/basic.tcl
View file @
6e0e5bed
start_server
{}
{
start_server
{
tags
{
basic
}
}
{
test
{
DEL all keys to start with a clean DB
}
{
foreach key
[
r keys *
]
{
r del $key
}
r dbsize
...
...
@@ -52,6 +52,7 @@ start_server {} {
r get foo
}
[
string repeat
"abcd"
1000000
]
tags
{
slow
}
{
test
{
Very big payload random access
}
{
set err
{}
array set payload
{}
...
...
@@ -92,6 +93,7 @@ start_server {} {
test
{
DBSIZE should be 10101 now
}
{
r dbsize
}
{
10101
}
}
test
{
INCR against non existing key
}
{
set res
{}
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment