Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
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