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
9fcfd6b6
Commit
9fcfd6b6
authored
Jun 03, 2010
by
antirez
Browse files
Merge branch 'testsuite' of
git://github.com/pietern/redis
parents
a89b7013
5a9fcb87
Changes
17
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
9fcfd6b6
...
@@ -86,7 +86,7 @@ staticsymbols:
...
@@ -86,7 +86,7 @@ staticsymbols:
tclsh utils/build-static-symbols.tcl
>
staticsymbols.h
tclsh utils/build-static-symbols.tcl
>
staticsymbols.h
test
:
test
:
tclsh8.5 tests/test_helper.tcl
tclsh8.5 tests/test_helper.tcl
--tags
"
${TAGS}
"
bench
:
bench
:
./redis-benchmark
./redis-benchmark
...
...
tests/integration/aof.tcl
View file @
9fcfd6b6
set defaults
[
list
[
list
appendonly yes
]
[
list
appendfilename appendonly.aof
]]
set defaults
{
appendonly
{
yes
}
appendfilename
{
appendonly.aof
}
}
set server_path
[
tmpdir server.aof
]
set server_path
[
tmpdir server.aof
]
set aof_path
"
$server
_path/appendonly.aof"
set aof_path
"
$server
_path/appendonly.aof"
...
@@ -16,65 +16,67 @@ proc create_aof {code} {
...
@@ -16,65 +16,67 @@ proc create_aof {code} {
proc start_server_aof
{
overrides code
}
{
proc start_server_aof
{
overrides code
}
{
upvar defaults defaults srv srv server_path server_path
upvar defaults defaults srv srv server_path server_path
set
_defaults $defaults
set
config
[
concat $defaults $overrides
]
set srv
[
start_server
default.conf
[
lappend _defaults $
overrides
]]
set srv
[
start_server
[
list
overrides
$config
]]
uplevel 1 $code
uplevel 1 $code
kill_server $srv
kill_server $srv
}
}
## Test the server doesn't start when the AOF contains an unfinished MULTI
tags
{
"aof"
}
{
create_aof
{
## Test the server doesn't start when the AOF contains an unfinished MULTI
append_to_aof
[
formatCommand set foo hello
]
create_aof
{
append_to_aof
[
formatCommand multi
]
append_to_aof
[
formatCommand set foo hello
]
append_to_aof
[
formatCommand set bar world
]
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
}
{
test
{
Unfinished MULTI: Server should not have been started
}
{
is_alive $srv
is_alive $srv
}
{
0
}
}
{
0
}
test
{
Unfinished MULTI: Server should have logged an error
}
{
test
{
Unfinished MULTI: Server should have logged an error
}
{
exec cat
[
dict get $srv stdout
]
| tail -n1
exec cat
[
dict get $srv stdout
]
| tail -n1
}
{
*Unexpected end of file reading the append only file*
}
}
{
*Unexpected end of file reading the append only file*
}
}
}
## Test that the server exits when the AOF contains a short read
## Test that the server exits when the AOF contains a short read
create_aof
{
create_aof
{
append_to_aof
[
formatCommand set foo hello
]
append_to_aof
[
formatCommand set foo hello
]
append_to_aof
[
string range
[
formatCommand set bar world
]
0 end-1
]
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
}
{
test
{
Short read: Server should not have been started
}
{
is_alive $srv
is_alive $srv
}
{
0
}
}
{
0
}
test
{
Short read: Server should have logged an error
}
{
test
{
Short read: Server should have logged an error
}
{
exec cat
[
dict get $srv stdout
]
| tail -n1
exec cat
[
dict get $srv stdout
]
| tail -n1
}
{
*Bad file format reading the append only file*
}
}
{
*Bad file format reading the append only file*
}
}
}
## Test that redis-check-aof indeed sees this 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
}
{
test
{
Short read: Utility should confirm the AOF is not valid
}
{
catch
{
catch
{
exec ./redis-check-aof $aof_path
exec ./redis-check-aof $aof_path
}
str
}
str
set _ $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
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
## Test that the server can be started using the truncated AOF
start_server_aof
[
list dir $server_path
]
{
start_server_aof
[
list dir $server_path
]
{
test
{
Fixed AOF: Server should have been started
}
{
test
{
Fixed AOF: Server should have been started
}
{
is_alive $srv
is_alive $srv
}
{
1
}
}
{
1
}
test
{
Fixed AOF: Keyspace should contain values that were parsable
}
{
test
{
Fixed AOF: Keyspace should contain values that were parsable
}
{
set client
[
redis
[
dict get $srv host
]
[
dict get $srv port
]]
set client
[
redis
[
dict get $srv host
]
[
dict get $srv port
]]
list
[
$client
get foo
]
[
$client
get bar
]
list
[
$client
get foo
]
[
$client
get bar
]
}
{
hello
{}}
}
{
hello
{}}
}
}
}
tests/integration/replication.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"repl"
}
}
{
r set mykey foo
r set mykey foo
start_server
default.conf
{}
{
start_server
{}
{
test
{
Second server should have role master at first
}
{
test
{
Second server should have role master at first
}
{
s role
s role
}
{
master
}
}
{
master
}
...
...
tests/support/server.tcl
View file @
9fcfd6b6
set ::global_overrides
{}
set ::tags
{}
proc error_and_quit
{
config_file error
}
{
proc error_and_quit
{
config_file error
}
{
puts
"!!COULD NOT START REDIS-SERVER
\n
"
puts
"!!COULD NOT START REDIS-SERVER
\n
"
puts
"CONFIGURATION:"
puts
"CONFIGURATION:"
...
@@ -27,11 +30,15 @@ proc kill_server config {
...
@@ -27,11 +30,15 @@ proc kill_server config {
set pid
[
dict get $config pid
]
set pid
[
dict get $config pid
]
# check for leaks
# check for leaks
catch
{
if
{
!
[
dict exists $config
"skipleaks"
]}
{
if
{[
string match
{
*Darwin*
}
[
exec uname -a
]]}
{
catch
{
test
"Check for memory leaks (pid
$pid
)"
{
if
{[
string match
{
*Darwin*
}
[
exec uname -a
]]}
{
exec leaks $pid
tags
{
"leaks"
}
{
}
{
*0 leaks*
}
test
"Check for memory leaks (pid
$pid
)"
{
exec leaks $pid
}
{
*0 leaks*
}
}
}
}
}
}
}
...
@@ -78,9 +85,35 @@ proc ping_server {host port} {
...
@@ -78,9 +85,35 @@ proc ping_server {host port} {
return $retval
return $retval
}
}
set ::global_overrides
{}
# doesn't really belong here, but highly coupled to code in start_server
proc start_server
{
filename overrides
{
code undefined
}}
{
proc tags
{
tags code
}
{
set data
[
split
[
exec cat
"tests/assets/
$filename
"
]
"
\n
"
]
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
{}
set config
{}
foreach line $data
{
foreach line $data
{
if
{[
string length $line
]
> 0 &&
[
string index $line 0
]
ne
"#"
}
{
if
{[
string length $line
]
> 0 &&
[
string index $line 0
]
ne
"#"
}
{
...
@@ -98,9 +131,7 @@ proc start_server {filename overrides {code undefined}} {
...
@@ -98,9 +131,7 @@ proc start_server {filename overrides {code undefined}} {
dict set config port
[
incr ::port
]
dict set config port
[
incr ::port
]
# apply overrides from global space and arguments
# apply overrides from global space and arguments
foreach override
[
concat $::global_overrides $overrides
]
{
foreach
{
directive arguments
}
[
concat $::global_overrides $overrides
]
{
set directive
[
lrange $override 0 0
]
set arguments
[
lrange $override 1 end
]
dict set config $directive $arguments
dict set config $directive $arguments
}
}
...
@@ -177,19 +208,40 @@ proc start_server {filename overrides {code undefined}} {
...
@@ -177,19 +208,40 @@ proc start_server {filename overrides {code undefined}} {
lappend ::servers $srv
lappend ::servers $srv
# execute provided block
# execute provided block
set curnum $::testnum
catch
{
uplevel 1 $code
}
err
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
# pop the server object
set ::servers
[
lrange $::servers 0 end-1
]
set ::servers
[
lrange $::servers 0 end-1
]
kill_server $srv
# 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
{[
string length $err
]
> 0
}
{
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
error
"exception"
}
elseif
{[
string length $err
]
> 0
}
{
puts
"Error executing the suite, aborting..."
puts
"Error executing the suite, aborting..."
puts $err
puts $err
exit 1
exit 1
}
}
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
kill_server $srv
}
else
{
}
else
{
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
set _ $srv
set _ $srv
}
}
}
}
tests/support/test.tcl
View file @
9fcfd6b6
...
@@ -3,20 +3,34 @@ set ::failed 0
...
@@ -3,20 +3,34 @@ set ::failed 0
set ::testnum 0
set ::testnum 0
proc test
{
name code okpattern
}
{
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
incr ::testnum
# if
{
$::testnum
< $::first || $::testnum > $::last
}
return
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
puts -nonewline
[
format
"#%03d %-68s "
$::testnum $name
]
flush stdout
flush stdout
if
{[
catch
{
set retval
[
uplevel 1 $code
]}
error
]}
{
if
{[
catch
{
set retval
[
uplevel 1 $code
]}
error
]}
{
puts
"ERROR
\n\n
Logged warnings:"
puts
"EXCEPTION"
foreach file
[
glob tests/tmp/server.
[
pid
]
.*/stdout
]
{
puts
"
\n
Caught error:
$error
"
set warnings
[
warnings_from_file $file
]
error
"exception"
if
{[
string length $warnings
]
> 0
}
{
puts $warnings
}
}
puts
"Script died with
$error
"
exit 1
}
}
if
{
$okpattern
eq $retval ||
[
string match $okpattern $retval
]}
{
if
{
$okpattern
eq $retval ||
[
string match $okpattern $retval
]}
{
puts
"PASSED"
puts
"PASSED"
...
...
tests/test_helper.tcl
View file @
9fcfd6b6
...
@@ -13,9 +13,10 @@ set ::host 127.0.0.1
...
@@ -13,9 +13,10 @@ set ::host 127.0.0.1
set ::port 16379
set ::port 16379
set ::traceleaks 0
set ::traceleaks 0
set ::valgrind 0
set ::valgrind 0
set ::denytags
{}
set ::allowtags
{}
proc execute_tests name
{
proc execute_tests name
{
set cur $::testnum
source
"tests/
$name.tcl
"
source
"tests/
$name.tcl
"
}
}
...
@@ -92,4 +93,31 @@ proc main {} {
...
@@ -92,4 +93,31 @@ proc main {} {
cleanup
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 @
9fcfd6b6
start_server
default.conf
{
{
requirepass foobar
}}
{
start_server
{
tags
{
"auth"
}
overrides
{
requirepass foobar
}}
{
test
{
AUTH fails when a wrong password is given
}
{
test
{
AUTH fails when a wrong password is given
}
{
catch
{
r auth wrong!
}
err
catch
{
r auth wrong!
}
err
format $err
format $err
...
...
tests/unit/basic.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"basic"
}
}
{
test
{
DEL all keys to start with a clean DB
}
{
test
{
DEL all keys to start with a clean DB
}
{
foreach key
[
r keys *
]
{
r del $key
}
foreach key
[
r keys *
]
{
r del $key
}
r dbsize
r dbsize
...
@@ -52,46 +52,48 @@ start_server default.conf {} {
...
@@ -52,46 +52,48 @@ start_server default.conf {} {
r get foo
r get foo
}
[
string repeat
"abcd"
1000000
]
}
[
string repeat
"abcd"
1000000
]
test
{
Very big payload random access
}
{
tags
{
"slow"
}
{
set err
{}
test
{
Very big payload random access
}
{
array set payload
{}
set err
{}
for
{
set j 0
}
{
$j
< 100
}
{
incr j
}
{
array set payload
{}
set size
[
expr 1+
[
randomInt 100000
]]
for
{
set j 0
}
{
$j
< 100
}
{
incr j
}
{
set buf
[
string repeat
"pl-
$j
"
$size
]
set size
[
expr 1+
[
randomInt 100000
]]
set payload
(
$j
)
$buf
set buf
[
string repeat
"pl-
$j
"
$size
]
r set bigpayload_$j $buf
set payload
(
$j
)
$buf
}
r set bigpayload_$j $buf
for
{
set j 0
}
{
$j
< 1000
}
{
incr j
}
{
set index
[
randomInt 100
]
set buf
[
r get bigpayload_$index
]
if
{
$buf
!= $payload
(
$index
)}
{
set err
"Values differ: I set '
$payload
(
$index
)' but I read back '
$buf
'"
break
}
}
}
for
{
set j 0
}
{
$j
< 1000
}
{
incr j
}
{
unset payload
set index
[
randomInt 100
]
set _ $err
set buf
[
r get bigpayload_$index
]
}
{}
if
{
$buf
!= $payload
(
$index
)}
{
set err
"Values differ: I set '
$payload
(
$index
)' but I read back '
$buf
'"
test
{
SET 10000 numeric keys and access all them in reverse order
}
{
break
set err
{}
}
for
{
set x 0
}
{
$x
< 10000
}
{
incr x
}
{
r set $x $x
}
set sum 0
for
{
set x 9999
}
{
$x
>= 0
}
{
incr x -1
}
{
set val
[
r get $x
]
if
{
$val
ne $x
}
{
set err
"Eleemnt at position
$x
is
$val
instead of
$x
"
break
}
}
}
unset payload
set _ $err
set _ $err
}
{}
}
{}
test
{
SET 10000 numeric keys and access all them in reverse order
}
{
set err
{}
for
{
set x 0
}
{
$x
< 10000
}
{
incr x
}
{
r set $x $x
}
set sum 0
for
{
set x 9999
}
{
$x
>= 0
}
{
incr x -1
}
{
set val
[
r get $x
]
if
{
$val
ne $x
}
{
set err
"Eleemnt at position
$x
is
$val
instead of
$x
"
break
}
}
set _ $err
}
{}
test
{
DBSIZE should be 10101 now
}
{
test
{
DBSIZE should be 10101 now
}
{
r dbsize
r dbsize
}
{
10101
}
}
{
10101
}
}
test
{
INCR against non existing key
}
{
test
{
INCR against non existing key
}
{
set res
{}
set res
{}
...
...
tests/unit/cas.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"cas"
}
}
{
test
{
EXEC works on WATCHed key not modified
}
{
test
{
EXEC works on WATCHed key not modified
}
{
r watch x y z
r watch x y z
r watch k
r watch k
...
...
tests/unit/expire.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"expire"
}
}
{
test
{
EXPIRE - don't set timeouts multiple times
}
{
test
{
EXPIRE - don't set timeouts multiple times
}
{
r set x foobar
r set x foobar
set v1
[
r expire x 5
]
set v1
[
r expire x 5
]
...
@@ -12,10 +12,12 @@ start_server default.conf {} {
...
@@ -12,10 +12,12 @@ start_server default.conf {} {
r get x
r get x
}
{
foobar
}
}
{
foobar
}
test
{
EXPIRE - After 6 seconds the key should no longer be here
}
{
tags
{
"slow"
}
{
after 6000
test
{
EXPIRE - After 6 seconds the key should no longer be here
}
{
list
[
r get x
]
[
r exists x
]
after 6000
}
{{}
0
}
list
[
r get x
]
[
r exists x
]
}
{{}
0
}
}
test
{
EXPIRE - Delete on write policy
}
{
test
{
EXPIRE - Delete on write policy
}
{
r del x
r del x
...
@@ -46,10 +48,12 @@ start_server default.conf {} {
...
@@ -46,10 +48,12 @@ start_server default.conf {} {
r get y
r get y
}
{
foo
}
}
{
foo
}
test
{
SETEX - Wait for the key to expire
}
{
tags
{
"slow"
}
{
after 3000
test
{
SETEX - Wait for the key to expire
}
{
r get y
after 3000
}
{}
r get y
}
{}
}
test
{
SETEX - Wrong time parameter
}
{
test
{
SETEX - Wrong time parameter
}
{
catch
{
r setex z -10 foo
}
e
catch
{
r setex z -10 foo
}
e
...
...
tests/unit/other.tcl
View file @
9fcfd6b6
start_server
default.conf
{}
{
start_server
{}
{
test
{
SAVE - make sure there are all the types as values
}
{
test
{
SAVE - make sure there are all the types as values
}
{
# Wait for a background saving in progress to terminate
# Wait for a background saving in progress to terminate
waitForBgsave r
waitForBgsave r
...
@@ -12,20 +12,22 @@ start_server default.conf {} {
...
@@ -12,20 +12,22 @@ start_server default.conf {} {
r save
r save
}
{
OK
}
}
{
OK
}
foreach fuzztype
{
binary alpha compr
}
{
tags
{
"slow"
}
{
test
"FUZZ stresser with data model
$fuzztype
"
{
foreach fuzztype
{
binary alpha compr
}
{
set err 0
test
"FUZZ stresser with data model
$fuzztype
"
{
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
set err 0
set fuzz
[
randstring 0 512 $fuzztype
]
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
r set foo $fuzz
set fuzz
[
randstring 0 512 $fuzztype
]
set got
[
r get foo
]
r set foo $fuzz
if
{
$got
ne $fuzz
}
{
set got
[
r get foo
]
set err
[
list $fuzz $got
]
if
{
$got
ne $fuzz
}
{
break
set err
[
list $fuzz $got
]
break
}
}
}
}
set _ $err
set _ $err
}
{
0
}
}
{
0
}
}
}
}
test
{
BGSAVE
}
{
test
{
BGSAVE
}
{
...
...
tests/unit/protocol.tcl
View file @
9fcfd6b6
start_server
default.conf
{}
{
start_server
{}
{
test
{
Handle an empty query well
}
{
test
{
Handle an empty query well
}
{
set fd
[
r channel
]
set fd
[
r channel
]
puts -nonewline $fd
"
\r\n
"
puts -nonewline $fd
"
\r\n
"
...
...
tests/unit/sort.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"sort"
}
}
{
test
{
SORT ALPHA against integer encoded strings
}
{
test
{
SORT ALPHA against integer encoded strings
}
{
r del mylist
r del mylist
r lpush mylist 2
r lpush mylist 2
...
@@ -8,130 +8,132 @@ start_server default.conf {} {
...
@@ -8,130 +8,132 @@ start_server default.conf {} {
r sort mylist alpha
r sort mylist alpha
}
{
1 10 2 3
}
}
{
1 10 2 3
}
test
{
Create a random list and a random set
}
{
tags
{
"slow"
}
{
set tosort
{}
set res
{}
array set seenrand
{}
test
{
Create a random list and a random set
}
{
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
set tosort
{}
while 1
{
array set seenrand
{}
# Make sure all the weights are different because
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
# Redis does not use a stable sort but Tcl does.
while 1
{
randpath
{
# Make sure all the weights are different because
set rint
[
expr int
(
rand
()
*1000000
)]
# Redis does not use a stable sort but Tcl does.
}
{
randpath
{
set rint
[
expr rand
()]
set rint
[
expr int
(
rand
()
*1000000
)]
}
{
set rint
[
expr rand
()]
}
if
{
!
[
info exists seenrand
(
$rint
)]}
break
}
}
if
{
!
[
info exists seenrand
(
$rint
)]}
break
set seenrand
(
$rint
)
x
r lpush tosort $i
r sadd tosort-set $i
r set weight_$i $rint
r hset wobj_$i weight $rint
lappend tosort
[
list $i $rint
]
}
}
set seenrand
(
$rint
)
x
set sorted
[
lsort -index 1 -real $tosort
]
r lpush tosort $i
for
{
set i 0
}
{
$i
< 10000
}
{
incr i
}
{
r sadd tosort-set $i
lappend res
[
lindex $sorted $i 0
]
r set weight_$i $rint
r hset wobj_$i weight $rint
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
]
}
format
{}
}
{}
test
{
SORT with BY against the newly created list
}
{
r sort tosort
{
BY weight_*
}
}
$res
test
{
SORT with BY
(
hash field
)
against the newly created list
}
{
r sort tosort
{
BY wobj_*->weight
}
}
$res
test
{
SORT with GET
(
key+hash
)
with sanity check of each element
(
list
)}
{
set err
{}
set l1
[
r sort tosort GET # GET weight_*
]
set l2
[
r sort tosort GET # GET wobj_*->weight
]
foreach
{
id1 w1
}
$l1
{
id2 w2
}
$l2
{
set realweight
[
r get weight_$id1
]
if
{
$id1
!= $id2
}
{
set err
"ID mismatch
$id1
!=
$id2
"
break
}
}
if
{
$realweight
!= $w1 || $realweight != $w2
}
{
format
{}
set err
"Weights mismatch! w1:
$w1
w2:
$w2
real:
$realweight
"
}
{}
break
test
{
SORT with BY against the newly created list
}
{
r sort tosort
{
BY weight_*
}
}
$res
test
{
SORT with BY
(
hash field
)
against the newly created list
}
{
r sort tosort
{
BY wobj_*->weight
}
}
$res
test
{
SORT with GET
(
key+hash
)
with sanity check of each element
(
list
)}
{
set err
{}
set l1
[
r sort tosort GET # GET weight_*
]
set l2
[
r sort tosort GET # GET wobj_*->weight
]
foreach
{
id1 w1
}
$l1
{
id2 w2
}
$l2
{
set realweight
[
r get weight_$id1
]
if
{
$id1
!= $id2
}
{
set err
"ID mismatch
$id1
!=
$id2
"
break
}
if
{
$realweight
!= $w1 || $realweight != $w2
}
{
set err
"Weights mismatch! w1:
$w1
w2:
$w2
real:
$realweight
"
break
}
}
}
}
set _ $err
set _ $err
}
{}
}
{}
test
{
SORT with BY, but against the newly created set
}
{
test
{
SORT with BY, but against the newly created set
}
{
r sort tosort-set
{
BY weight_*
}
r sort tosort-set
{
BY weight_*
}
}
$res
}
$res
test
{
SORT with BY
(
hash field
)
, but against the newly created set
}
{
test
{
SORT with BY
(
hash field
)
, but against the newly created set
}
{
r sort tosort-set
{
BY wobj_*->weight
}
r sort tosort-set
{
BY wobj_*->weight
}
}
$res
}
$res
test
{
SORT with BY and STORE against the newly created list
}
{
test
{
SORT with BY and STORE against the newly created list
}
{
r sort tosort
{
BY weight_*
}
store sort-res
r sort tosort
{
BY weight_*
}
stor
e sort-res
r lrang
e sort-res
0 -1
r lrange sort-res 0 -1
}
$res
}
$res
test
{
SORT with BY
(
hash field
)
and STORE against the newly created list
}
{
test
{
SORT with BY
(
hash field
)
and STORE against the newly created list
}
{
r sort tosort
{
BY wobj_*->weight
}
store sort-res
r sort tosort
{
BY wobj_*->weight
}
stor
e sort-res
r lrang
e sort-res
0 -1
r lrange sort-res 0 -1
}
$res
}
$res
test
{
SORT direct, numeric, against the newly created list
}
{
test
{
SORT direct, numeric, against the newly created list
}
{
r sort tosort
r
sort
tosort
}
[
l
sort
-integer $res
]
}
[
lsort -integer $res
]
test
{
SORT decreasing sort
}
{
test
{
SORT decreasing
sort
}
{
r sort to
sort
{
DESC
}
r
sort
tosort
{
DESC
}
}
[
l
sort
-decreasing -integer $res
]
}
[
lsort -decreasing -integer $res
]
test
{
SORT speed, sorting 10000 elements list using BY, 100 times
}
{
test
{
SORT speed, sorting 10000 elements list using BY, 100 times
}
{
set start
[
clock clicks -milliseconds
]
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set sorted
[
r sort tosort
{
BY weight_* LIMIT 0 10
}]
set sorted
[
r sort tosort
{
BY weight_* LIMIT 0 10
}]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -
milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds
"
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
flush stdout
format
{}
format
{}
}
{}
}
{}
test
{
SORT speed, as above but against hash field
}
{
test
{
SORT speed, as above but against hash field
}
{
set start
[
clock clicks -milliseconds
]
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set sorted
[
r sort tosort
{
BY wobj_*->weight LIMIT 0 10
}]
set sorted
[
r sort tosort
{
BY wobj_*->weight LIMIT 0 10
}]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -
milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds
"
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
flush stdout
format
{}
format
{}
}
{}
}
{}
test
{
SORT speed, sorting 10000 elements list directly, 100 times
}
{
test
{
SORT speed, sorting 10000 elements list directly, 100 times
}
{
set start
[
clock clicks -milliseconds
]
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
for
{
set i 0
}
{
$i
<
10
0
}
{
incr i
}
{
set sorted
[
r sort tosort
{
LIMIT 0
10
}
]
set sorted
[
r sort tosort
{
LIMIT 0 10
}]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -
milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds
"
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
flush stdout
format
{}
format
{}
}
{}
}
{}
test
{
SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times
}
{
test
{
SORT speed, pseudo-sorting 10000 elements list, BY <const>, 100 times
}
{
set start
[
clock clicks -milliseconds
]
set start
[
clock clicks -milliseconds
]
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
for
{
set i 0
}
{
$i
<
10
0
}
{
incr i
}
{
set sorted
[
r sort tosort
{
BY nokey LIMIT 0
10
}
]
set sorted
[
r sort tosort
{
BY nokey LIMIT 0 10
}]
}
}
set elapsed
[
expr
[
clock clicks -milliseconds
]
-$start
]
set elapsed
[
expr
[
clock clicks -
milliseconds
]
-$start
]
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds
"
puts -nonewline
"
\n
Average time to sort:
[
expr double
(
$elapsed
)
/100
]
milliseconds "
flush stdout
flush stdout
format
{}
format
{}
}
{}
}
{}
}
test
{
SORT regression for issue #19, sorting floats
}
{
test
{
SORT regression for issue #19, sorting floats
}
{
r flushdb
r flushdb
...
...
tests/unit/type/hash.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"hash"
}
}
{
test
{
HSET/HLEN - Small hash creation
}
{
test
{
HSET/HLEN - Small hash creation
}
{
array set smallhash
{}
array set smallhash
{}
for
{
set i 0
}
{
$i
< 8
}
{
incr i
}
{
for
{
set i 0
}
{
$i
< 8
}
{
incr i
}
{
...
...
tests/unit/type/list.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"list"
}
}
{
test
{
Basic LPUSH, RPUSH, LLENGTH, LINDEX
}
{
test
{
Basic LPUSH, RPUSH, LLENGTH, LINDEX
}
{
set res
[
r lpush mylist a
]
set res
[
r lpush mylist a
]
append res
[
r lpush mylist b
]
append res
[
r lpush mylist b
]
...
...
tests/unit/type/set.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"set"
}
}
{
test
{
SADD, SCARD, SISMEMBER, SMEMBERS basics
}
{
test
{
SADD, SCARD, SISMEMBER, SMEMBERS basics
}
{
r sadd myset foo
r sadd myset foo
r sadd myset bar
r sadd myset bar
...
...
tests/unit/type/zset.tcl
View file @
9fcfd6b6
start_server
default.conf
{
}
{
start_server
{
tags
{
"zset"
}
}
{
test
{
ZSET basic ZADD and score update
}
{
test
{
ZSET basic ZADD and score update
}
{
r zadd ztmp 10 x
r zadd ztmp 10 x
r zadd ztmp 20 y
r zadd ztmp 20 y
...
@@ -162,85 +162,87 @@ start_server default.conf {} {
...
@@ -162,85 +162,87 @@ start_server default.conf {} {
r zrangebyscore zset 2 4 withscores
r zrangebyscore zset 2 4 withscores
}
{
b 2 c 3 d 4
}
}
{
b 2 c 3 d 4
}
test
{
ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set
}
{
tags
{
"slow"
}
{
set err
{}
test
{
ZRANGEBYSCORE fuzzy test, 100 ranges in 1000 elements sorted set
}
{
r del zset
set err
{}
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
r del zset
r zadd zset
[
expr rand
()]
$i
for
{
set i 0
}
{
$i
< 1000
}
{
incr i
}
{
}
r zadd zset
[
expr rand
()]
$i
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set min
[
expr rand
()]
set max
[
expr rand
()]
if
{
$min
> $max
}
{
set aux $min
set min $max
set max $aux
}
set low
[
r zrangebyscore zset -inf $min
]
set ok
[
r zrangebyscore zset $min $max
]
set high
[
r zrangebyscore zset $max +inf
]
set lowx
[
r zrangebyscore zset -inf
(
$min
]
set okx
[
r zrangebyscore zset
(
$min
(
$max
]
set highx
[
r zrangebyscore zset
(
$max
+inf
]
if
{[
r zcount zset -inf $min
]
!=
[
llength $low
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset $min $max
]
!=
[
llength $ok
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset $max +inf
]
!=
[
llength $high
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset -inf
(
$min
]
!=
[
llength $lowx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset
(
$min
(
$max
]
!=
[
llength $okx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset
(
$max
+inf
]
!=
[
llength $highx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
}
for
{
set i 0
}
{
$i
< 100
}
{
incr i
}
{
set min
[
expr rand
()]
set max
[
expr rand
()]
if
{
$min
> $max
}
{
set aux $min
set min $max
set max $aux
}
set low
[
r zrangebyscore zset -inf $min
]
set ok
[
r zrangebyscore zset $min $max
]
set high
[
r zrangebyscore zset $max +inf
]
set lowx
[
r zrangebyscore zset -inf
(
$min
]
set okx
[
r zrangebyscore zset
(
$min
(
$max
]
set highx
[
r zrangebyscore zset
(
$max
+inf
]
if
{[
r zcount zset -inf $min
]
!=
[
llength $low
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset $min $max
]
!=
[
llength $ok
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset $max +inf
]
!=
[
llength $high
]}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset -inf
(
$min
]
!=
[
llength $lowx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset
(
$min
(
$max
]
!=
[
llength $okx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
if
{[
r zcount zset
(
$max
+inf
]
!=
[
llength $highx
]
}
{
append err
"Error, len does not match zcount
\n
"
}
foreach x $low
{
foreach x $low
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
> $min
}
{
if
{
$score
> $min
}
{
append err
"Error, score for
$x
is
$score
>
$min
\n
"
append err
"Error, score for
$x
is
$score
>
$min
\n
"
}
}
}
}
foreach x $lowx
{
foreach x $lowx
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
>= $min
}
{
if
{
$score
>= $min
}
{
append err
"Error, score for
$x
is
$score
>=
$min
\n
"
append err
"Error, score for
$x
is
$score
>=
$min
\n
"
}
}
}
}
foreach x $ok
{
foreach x $ok
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
< $min || $score > $max
}
{
if
{
$score
< $min || $score > $max
}
{
append err
"Error, score for
$x
is
$score
outside
$min-$max
range
\n
"
append err
"Error, score for
$x
is
$score
outside
$min-$max
range
\n
"
}
}
}
}
foreach x $okx
{
foreach x $okx
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
<= $min || $score >= $max
}
{
if
{
$score
<= $min || $score >= $max
}
{
append err
"Error, score for
$x
is
$score
outside
$min-$max
open range
\n
"
append err
"Error, score for
$x
is
$score
outside
$min-$max
open range
\n
"
}
}
}
}
foreach x $high
{
foreach x $high
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
< $max
}
{
if
{
$score
< $max
}
{
append err
"Error, score for
$x
is
$score
<
$max
\n
"
append err
"Error, score for
$x
is
$score
<
$max
\n
"
}
}
}
}
foreach x $highx
{
foreach x $highx
{
set score
[
r zscore zset $x
]
set score
[
r zscore zset $x
]
if
{
$score
<= $max
}
{
if
{
$score
<= $max
}
{
append err
"Error, score for
$x
is
$score
<=
$max
\n
"
append err
"Error, score for
$x
is
$score
<=
$max
\n
"
}
}
}
}
}
}
set _ $err
set _ $err
}
{}
}
{}
}
test
{
ZRANGEBYSCORE with LIMIT
}
{
test
{
ZRANGEBYSCORE with LIMIT
}
{
r del zset
r del zset
...
@@ -356,47 +358,49 @@ start_server default.conf {} {
...
@@ -356,47 +358,49 @@ start_server default.conf {} {
list
[
r zinterstore zsetc 2 zseta zsetb aggregate max
]
[
r zrange zsetc 0 -1 withscores
]
list
[
r zinterstore zsetc 2 zseta zsetb aggregate max
]
[
r zrange zsetc 0 -1 withscores
]
}
{
2
{
b 2 c 3
}}
}
{
2
{
b 2 c 3
}}
test
{
ZSETs skiplist implementation backlink consistency test
}
{
tags
{
"slow"
}
{
set diff 0
test
{
ZSETs skiplist implementation backlink consistency test
}
{
set elements 10000
set diff 0
for
{
set j 0
}
{
$j
< $elements
}
{
incr j
}
{
set elements 10000
r zadd myzset
[
expr rand
()]
"Element-
$j
"
for
{
set j 0
}
{
$j
< $elements
}
{
incr j
}
{
r zrem myzset
"Element-
[
expr int
(
rand
()
*$elements
)]
"
r zadd myzset
[
expr rand
()]
"Element-
$j
"
}
r zrem myzset
"Element-
[
expr int
(
rand
()
*$elements
)]
"
set l1
[
r zrange myzset 0 -1
]
set l2
[
r zrevrange myzset 0 -1
]
for
{
set j 0
}
{
$j
<
[
llength $l1
]}
{
incr j
}
{
if
{[
lindex $l1 $j
]
ne
[
lindex $l2 end-$j
]}
{
incr diff
}
}
}
set l1
[
r zrange myzset 0 -1
]
format $diff
set l2
[
r zrevrange myzset 0 -1
]
}
{
0
}
for
{
set j 0
}
{
$j
<
[
llength $l1
]}
{
incr j
}
{
if
{[
lindex $l1 $j
]
ne
[
lindex $l2 end-$j
]}
{
test
{
ZSETs ZRANK augmented skip list stress testing
}
{
incr diff
set err
{}
}
r del myzset
for
{
set k 0
}
{
$k
< 10000
}
{
incr k
}
{
set i
[
expr
{
$k
%1000
}]
if
{[
expr rand
()]
< .2
}
{
r zrem myzset $i
}
else
{
set score
[
expr rand
()]
r zadd myzset $score $i
}
}
set card
[
r zcard myzset
]
format $diff
if
{
$card
> 0
}
{
}
{
0
}
set index
[
randomInt $card
]
set ele
[
lindex
[
r zrange myzset $index $index
]
0
]
test
{
ZSETs ZRANK augmented skip list stress testing
}
{
set rank
[
r zrank myzset $ele
]
set err
{}
if
{
$rank
!= $index
}
{
r del myzset
set err
"
$ele
RANK is wrong! (
$rank
!=
$index
)"
for
{
set k 0
}
{
$k
< 10000
}
{
incr k
}
{
break
set i
[
expr
{
$k
%1000
}]
if
{[
expr rand
()]
< .2
}
{
r zrem myzset $i
}
else
{
set score
[
expr rand
()]
r zadd myzset $score $i
}
set card
[
r zcard myzset
]
if
{
$card
> 0
}
{
set index
[
randomInt $card
]
set ele
[
lindex
[
r zrange myzset $index $index
]
0
]
set rank
[
r zrank myzset $ele
]
if
{
$rank
!= $index
}
{
set err
"
$ele
RANK is wrong! (
$rank
!=
$index
)"
break
}
}
}
}
}
}
set _ $err
set _ $err
}
{}
}
{}
}
test
{
ZSET element can't be set to nan with ZADD
}
{
test
{
ZSET element can't be set to nan with ZADD
}
{
set e
{}
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