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
a7159fe8
Commit
a7159fe8
authored
Jun 03, 2010
by
antirez
Browse files
Merge branch 'testsuite' of
git://github.com/pietern/redis
into smallkeys
parents
1edbae86
5a9fcb87
Changes
17
Show whitespace changes
Inline
Side-by-side
Makefile
View file @
a7159fe8
...
...
@@ -86,7 +86,7 @@ staticsymbols:
tclsh utils/build-static-symbols.tcl
>
staticsymbols.h
test
:
tclsh8.5 tests/test_helper.tcl
tclsh8.5 tests/test_helper.tcl
--tags
"
${TAGS}
"
bench
:
./redis-benchmark
...
...
tests/integration/aof.tcl
View file @
a7159fe8
set defaults
[
list
[
list
appendonly yes
]
[
list
appendfilename appendonly.aof
]]
set defaults
{
appendonly
{
yes
}
appendfilename
{
appendonly.aof
}
}
set server_path
[
tmpdir server.aof
]
set aof_path
"
$server
_path/appendonly.aof"
...
...
@@ -16,20 +16,21 @@ proc create_aof {code} {
proc start_server_aof
{
overrides code
}
{
upvar defaults defaults srv srv server_path server_path
set
_defaults $defaults
set srv
[
start_server
default.conf
[
lappend _defaults $
overrides
]]
set
config
[
concat $defaults $overrides
]
set srv
[
start_server
[
list
overrides
$config
]]
uplevel 1 $code
kill_server $srv
}
## Test the server doesn't start when the AOF contains an unfinished MULTI
create_aof
{
tags
{
"aof"
}
{
## Test the server doesn't start when the AOF contains an unfinished MULTI
create_aof
{
append_to_aof
[
formatCommand set foo hello
]
append_to_aof
[
formatCommand multi
]
append_to_aof
[
formatCommand set bar world
]
}
}
start_server_aof
[
list dir $server_path
]
{
start_server_aof
[
list dir $server_path
]
{
test
{
Unfinished MULTI: Server should not have been started
}
{
is_alive $srv
}
{
0
}
...
...
@@ -37,15 +38,15 @@ start_server_aof [list dir $server_path] {
test
{
Unfinished MULTI: Server should have logged an error
}
{
exec cat
[
dict get $srv stdout
]
| tail -n1
}
{
*Unexpected end of file reading the append only file*
}
}
}
## Test that the server exits when the AOF contains a short read
create_aof
{
## Test that the server exits when the AOF contains a short read
create_aof
{
append_to_aof
[
formatCommand set foo hello
]
append_to_aof
[
string range
[
formatCommand set bar world
]
0 end-1
]
}
}
start_server_aof
[
list dir $server_path
]
{
start_server_aof
[
list dir $server_path
]
{
test
{
Short read: Server should not have been started
}
{
is_alive $srv
}
{
0
}
...
...
@@ -53,22 +54,22 @@ start_server_aof [list dir $server_path] {
test
{
Short read: Server should have logged an error
}
{
exec cat
[
dict get $srv stdout
]
| tail -n1
}
{
*Bad file format reading the append only file*
}
}
}
## Test that redis-check-aof indeed sees this AOF is not valid
test
{
Short read: Utility should confirm the AOF is not valid
}
{
## Test that redis-check-aof indeed sees this AOF is not valid
test
{
Short read: Utility should confirm the AOF is not valid
}
{
catch
{
exec ./redis-check-aof $aof_path
}
str
set _ $str
}
{
*not valid*
}
}
{
*not valid*
}
test
{
Short read: Utility should be able to fix the AOF
}
{
test
{
Short read: Utility should be able to fix the AOF
}
{
exec echo y | ./redis-check-aof --fix $aof_path
}
{
*Successfully truncated AOF*
}
}
{
*Successfully truncated AOF*
}
## Test that the server can be started using the truncated AOF
start_server_aof
[
list dir $server_path
]
{
## Test that the server can be started using the truncated AOF
start_server_aof
[
list dir $server_path
]
{
test
{
Fixed AOF: Server should have been started
}
{
is_alive $srv
}
{
1
}
...
...
@@ -77,4 +78,5 @@ start_server_aof [list dir $server_path] {
set client
[
redis
[
dict get $srv host
]
[
dict get $srv port
]]
list
[
$client
get foo
]
[
$client
get bar
]
}
{
hello
{}}
}
}
tests/integration/replication.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"repl"
}
}
{
r set mykey foo
start_server
default.conf
{}
{
start_server
{}
{
test
{
Second server should have role master at first
}
{
s role
}
{
master
}
...
...
tests/support/server.tcl
View file @
a7159fe8
set ::global_overrides
{}
set ::tags
{}
proc error_and_quit
{
config_file error
}
{
puts
"!!COULD NOT START REDIS-SERVER
\n
"
puts
"CONFIGURATION:"
...
...
@@ -27,13 +30,17 @@ proc kill_server config {
set pid
[
dict get $config pid
]
# check for leaks
if
{
!
[
dict exists $config
"skipleaks"
]}
{
catch
{
if
{[
string match
{
*Darwin*
}
[
exec uname -a
]]}
{
tags
{
"leaks"
}
{
test
"Check for memory leaks (pid
$pid
)"
{
exec leaks $pid
}
{
*0 leaks*
}
}
}
}
}
# kill server and wait for the process to be totally exited
while
{[
is_alive $config
]}
{
...
...
@@ -78,9 +85,35 @@ proc ping_server {host port} {
return $retval
}
set ::global_overrides
{}
proc start_server
{
filename overrides
{
code undefined
}}
{
set data
[
split
[
exec cat
"tests/assets/
$filename
"
]
"
\n
"
]
# 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
}
"tags"
{
set tags $value
set ::tags
[
concat $::tags $value
]
}
default
{
error
"Unknown option
$option
"
}
}
}
set data
[
split
[
exec cat
"tests/assets/
$baseconfig
"
]
"
\n
"
]
set config
{}
foreach line $data
{
if
{[
string length $line
]
> 0 &&
[
string index $line 0
]
ne
"#"
}
{
...
...
@@ -98,9 +131,7 @@ proc start_server {filename overrides {code undefined}} {
dict set config port
[
incr ::port
]
# apply overrides from global space and arguments
foreach override
[
concat $::global_overrides $overrides
]
{
set directive
[
lrange $override 0 0
]
set arguments
[
lrange $override 1 end
]
foreach
{
directive arguments
}
[
concat $::global_overrides $overrides
]
{
dict set config $directive $arguments
}
...
...
@@ -177,19 +208,40 @@ proc start_server {filename overrides {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
]
# allow an exception to bubble up the call chain but still kill this
# server, because we want to reuse the ports when the tests are re-run
if
{
$err
eq
"exception"
}
{
puts
[
format
"Logged warnings (pid %d):"
[
dict get $srv
"pid"
]]
set warnings
[
warnings_from_file
[
dict get $srv
"stdout"
]]
if
{[
string length $warnings
]
> 0
}
{
puts
"
$warnings
"
}
else
{
puts
"(none)"
}
# kill this server without checking for leaks
dict set srv
"skipleaks"
1
kill_server $srv
if
{[
string length $err
]
> 0
}
{
error
"exception"
}
else
if
{[
string length $err
]
> 0
}
{
puts
"Error executing the suite, aborting..."
puts $err
exit 1
}
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
kill_server $srv
}
else
{
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
set _ $srv
}
}
tests/support/test.tcl
View file @
a7159fe8
...
...
@@ -3,20 +3,34 @@ 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
]
>= 0
}
{
incr matched
}
}
if
{
$matched
< 1
}
{
return
}
}
incr ::testnum
# if
{
$::testnum
< $::first || $::testnum > $::last
}
return
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
flush stdout
if
{[
catch
{
set retval
[
uplevel 1 $code
]}
error
]}
{
puts
"ERROR
\n\n
Logged warnings:"
foreach file
[
glob tests/tmp/server.
[
pid
]
.*/stdout
]
{
set warnings
[
warnings_from_file $file
]
if
{[
string length $warnings
]
> 0
}
{
puts $warnings
}
}
puts
"Script died with
$error
"
exit 1
puts
"EXCEPTION"
puts
"
\n
Caught error:
$error
"
error
"exception"
}
if
{
$okpattern
eq $retval ||
[
string match $okpattern $retval
]}
{
puts
"PASSED"
...
...
tests/test_helper.tcl
View file @
a7159fe8
...
...
@@ -13,9 +13,10 @@ set ::host 127.0.0.1
set ::port 16379
set ::traceleaks 0
set ::valgrind 0
set ::denytags
{}
set ::allowtags
{}
proc execute_tests name
{
set cur $::testnum
source
"tests/
$name.tcl
"
}
...
...
@@ -92,4 +93,31 @@ proc main {} {
cleanup
}
main
# parse arguments
for
{
set j 0
}
{
$j
<
[
llength $argv
]}
{
incr j
}
{
set opt
[
lindex $argv $j
]
set arg
[
lindex $argv
[
expr $j+1
]]
if
{
$opt
eq
{
--tags
}}
{
foreach tag $arg
{
if
{[
string index $tag 0
]
eq
"-"
}
{
lappend ::denytags
[
string range $tag 1 end
]
}
else
{
lappend ::allowtags $tag
}
}
incr j
}
else
{
puts
"Wrong argument:
$opt
"
exit 1
}
}
if
{[
catch
{
main
}
err
]}
{
if
{[
string length $err
]
> 0
}
{
# only display error when not generated by the test suite
if
{
$err
ne
"exception"
}
{
puts $err
}
exit 1
}
}
tests/unit/auth.tcl
View file @
a7159fe8
start_server
default.conf
{
{
requirepass foobar
}}
{
start_server
{
tags
{
"auth"
}
overrides
{
requirepass foobar
}}
{
test
{
AUTH fails when a wrong password is given
}
{
catch
{
r auth wrong!
}
err
format $err
...
...
tests/unit/basic.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
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 default.conf {} {
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 default.conf {} {
test
{
DBSIZE should be 10101 now
}
{
r dbsize
}
{
10101
}
}
test
{
INCR against non existing key
}
{
set res
{}
...
...
tests/unit/cas.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"cas"
}
}
{
test
{
EXEC works on WATCHed key not modified
}
{
r watch x y z
r watch k
...
...
tests/unit/expire.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"expire"
}
}
{
test
{
EXPIRE - don't set timeouts multiple times
}
{
r set x foobar
set v1
[
r expire x 5
]
...
...
@@ -12,10 +12,12 @@ start_server default.conf {} {
r get x
}
{
foobar
}
tags
{
"slow"
}
{
test
{
EXPIRE - After 6 seconds the key should no longer be here
}
{
after 6000
list
[
r get x
]
[
r exists x
]
}
{{}
0
}
}
test
{
EXPIRE - Delete on write policy
}
{
r del x
...
...
@@ -46,10 +48,12 @@ start_server default.conf {} {
r get y
}
{
foo
}
tags
{
"slow"
}
{
test
{
SETEX - Wait for the key to expire
}
{
after 3000
r get y
}
{}
}
test
{
SETEX - Wrong time parameter
}
{
catch
{
r setex z -10 foo
}
e
...
...
tests/unit/other.tcl
View file @
a7159fe8
start_server
default.conf
{}
{
start_server
{}
{
test
{
SAVE - make sure there are all the types as values
}
{
# Wait for a background saving in progress to terminate
waitForBgsave r
...
...
@@ -12,6 +12,7 @@ start_server default.conf {} {
r save
}
{
OK
}
tags
{
"slow"
}
{
foreach fuzztype
{
binary alpha compr
}
{
test
"FUZZ stresser with data model
$fuzztype
"
{
set err 0
...
...
@@ -27,6 +28,7 @@ start_server default.conf {} {
set _ $err
}
{
0
}
}
}
test
{
BGSAVE
}
{
waitForBgsave r
...
...
tests/unit/protocol.tcl
View file @
a7159fe8
start_server
default.conf
{}
{
start_server
{}
{
test
{
Handle an empty query well
}
{
set fd
[
r channel
]
puts -nonewline $fd
"
\r\n
"
...
...
tests/unit/sort.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"sort"
}
}
{
test
{
SORT ALPHA against integer encoded strings
}
{
r del mylist
r lpush mylist 2
...
...
@@ -8,6 +8,8 @@ start_server default.conf {} {
r sort mylist alpha
}
{
1 10 2 3
}
tags
{
"slow"
}
{
set res
{}
test
{
Create a random list and a random set
}
{
set tosort
{}
array set seenrand
{}
...
...
@@ -30,7 +32,6 @@ start_server default.conf {} {
lappend tosort
[
list $i $rint
]
}
set sorted
[
lsort -index 1 -real $tosort
]
set res
{}
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
lappend res
[
lindex $sorted $i 0
]
}
...
...
@@ -132,6 +133,7 @@ start_server default.conf {} {
flush stdout
format
{}
}
{}
}
test
{
SORT regression for issue #19, sorting floats
}
{
r flushdb
...
...
tests/unit/type/hash.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"hash"
}
}
{
test
{
HSET/HLEN - Small hash creation
}
{
array set smallhash
{}
for
{
set i 0
}
{
$i
< 8
}
{
incr i
}
{
...
...
tests/unit/type/list.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"list"
}
}
{
test
{
Basic LPUSH, RPUSH, LLENGTH, LINDEX
}
{
set res
[
r lpush mylist a
]
append res
[
r lpush mylist b
]
...
...
tests/unit/type/set.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"set"
}
}
{
test
{
SADD, SCARD, SISMEMBER, SMEMBERS basics
}
{
r sadd myset foo
r sadd myset bar
...
...
tests/unit/type/zset.tcl
View file @
a7159fe8
start_server
default.conf
{
}
{
start_server
{
tags
{
"zset"
}
}
{
test
{
ZSET basic ZADD and score update
}
{
r zadd ztmp 10 x
r zadd ztmp 20 y
...
...
@@ -162,6 +162,7 @@ start_server default.conf {} {
r zrangebyscore zset 2 4 withscores
}
{
b 2 c 3 d 4
}
tags
{
"slow"
}
{
test
{
ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set
}
{
set err
{}
r del zset
...
...
@@ -241,6 +242,7 @@ start_server default.conf {} {
}
set _ $err
}
{}
}
test
{
ZRANGEBYSCORE with LIMIT
}
{
r del zset
...
...
@@ -356,6 +358,7 @@ start_server default.conf {} {
list
[
r zinterstore zsetc 2 zseta zsetb aggregate max
]
[
r zrange zsetc 0 -1 withscores
]
}
{
2
{
b 2 c 3
}}
tags
{
"slow"
}
{
test
{
ZSETs skiplist implementation backlink consistency test
}
{
set diff 0
set elements 10000
...
...
@@ -397,6 +400,7 @@ start_server default.conf {} {
}
set _ $err
}
{}
}
test
{
ZSET element can't be set to nan with ZADD
}
{
set e
{}
...
...
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