Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
xindoo
redis
提交
6e0e5bed
R
redis
项目概览
xindoo
/
redis
通知
2
Star
2
Fork
0
代码
文件
提交
分支
Tags
贡献者
分支图
Diff
Issue
0
列表
看板
标记
里程碑
合并请求
0
Wiki
0
Wiki
分析
仓库
DevOps
项目成员
Pages
R
redis
项目概览
项目概览
详情
发布
仓库
仓库
文件
提交
分支
标签
贡献者
分支图
比较
Issue
0
Issue
0
列表
看板
标记
里程碑
合并请求
0
合并请求
0
Pages
分析
分析
仓库分析
DevOps
Wiki
0
Wiki
成员
成员
收起侧边栏
关闭侧边栏
动态
分支图
创建新Issue
提交
Issue看板
体验新版 GitCode,发现更多精彩内容 >>
提交
6e0e5bed
编写于
6月 02, 2010
作者:
P
Pieter Noordhuis
浏览文件
操作
浏览文件
下载
电子邮件补丁
差异文件
basic support to tag tests
上级
9e5d2e8b
变更
4
隐藏空白更改
内联
并排
Showing
4 changed file
with
54 addition
and
5 deletion
+54
-5
tests/support/server.tcl
tests/support/server.tcl
+28
-4
tests/support/test.tcl
tests/support/test.tcl
+21
-0
tests/test_helper.tcl
tests/test_helper.tcl
+2
-0
tests/unit/basic.tcl
tests/unit/basic.tcl
+3
-1
未找到文件。
tests/support/server.tcl
浏览文件 @
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
浏览文件 @
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
浏览文件 @
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
浏览文件 @
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
{}
...
...
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录