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
8341a7d4
Unverified
Commit
8341a7d4
authored
Feb 22, 2020
by
chendianqiang
Committed by
GitHub
Feb 22, 2020
Browse files
Merge pull request #3 from antirez/unstable
update
parents
49816941
e78c4e81
Changes
208
Hide whitespace changes
Inline
Side-by-side
tests/support/cli.tcl
0 → 100644
View file @
8341a7d4
proc rediscli_tls_config
{
testsdir
}
{
set tlsdir
[
file join $testsdir tls
]
set cert
[
file join $tlsdir redis.crt
]
set key
[
file join $tlsdir redis.key
]
set cacert
[
file join $tlsdir ca.crt
]
if
{
$::tls
}
{
return
[
list --tls --cert $cert --key $key --cacert $cacert
]
}
else
{
return
{}
}
}
proc rediscli
{
port
{
opts
{}}}
{
set cmd
[
list src/redis-cli -p $port
]
lappend cmd
{*}
[
rediscli_tls_config
"tests"
]
lappend cmd
{*}
$opts
return $cmd
}
tests/support/cluster.tcl
View file @
8341a7d4
...
@@ -62,7 +62,7 @@ proc ::redis_cluster::__method__refresh_nodes_map {id} {
...
@@ -62,7 +62,7 @@ proc ::redis_cluster::__method__refresh_nodes_map {id} {
lassign
[
split $ip_port :
]
start_host start_port
lassign
[
split $ip_port :
]
start_host start_port
if
{[
catch
{
if
{[
catch
{
set r
{}
set r
{}
set r
[
redis $start_host $start_port
]
set r
[
redis $start_host $start_port
0 $::tls
]
set nodes_descr
[
$r
cluster nodes
]
set nodes_descr
[
$r
cluster nodes
]
$r close
$r close
}
e
]}
{
}
e
]}
{
...
@@ -107,7 +107,7 @@ proc ::redis_cluster::__method__refresh_nodes_map {id} {
...
@@ -107,7 +107,7 @@ proc ::redis_cluster::__method__refresh_nodes_map {id} {
# Connect to the node
# Connect to the node
set link
{}
set link
{}
catch
{
set link
[
redis $host $port
]}
catch
{
set link
[
redis $host $port
0 $::tls
]}
# Build this node description as an hash.
# Build this node description as an hash.
set node
[
dict create
\
set node
[
dict create
\
...
...
tests/support/redis.tcl
View file @
8341a7d4
...
@@ -39,8 +39,18 @@ array set ::redis::callback {}
...
@@ -39,8 +39,18 @@ array set ::redis::callback {}
array set ::redis::state
{}
;
# State in non-blocking reply reading
array set ::redis::state
{}
;
# State in non-blocking reply reading
array set ::redis::statestack
{}
;
# Stack of states, for nested mbulks
array set ::redis::statestack
{}
;
# Stack of states, for nested mbulks
proc redis
{{
server 127.0.0.1
}
{
port 6379
}
{
defer 0
}}
{
proc redis
{{
server 127.0.0.1
}
{
port 6379
}
{
defer 0
}
{
tls 0
}
{
tlsoptions
{}}}
{
set fd
[
socket $server $port
]
if
{
$tls
}
{
package require tls
::tls::init
\
-cafile
"
$::tlsdir
/ca.crt"
\
-certfile
"
$::tlsdir
/redis.crt"
\
-keyfile
"
$::tlsdir
/redis.key"
\
{*}
$tlsoptions
set fd
[
::tls::socket $server $port
]
}
else
{
set fd
[
socket $server $port
]
}
fconfigure $fd -translation binary
fconfigure $fd -translation binary
set id
[
incr ::redis::id
]
set id
[
incr ::redis::id
]
set ::redis::fd
(
$id
)
$fd
set ::redis::fd
(
$id
)
$fd
...
@@ -48,6 +58,7 @@ proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
...
@@ -48,6 +58,7 @@ proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
set ::redis::blocking
(
$id
)
1
set ::redis::blocking
(
$id
)
1
set ::redis::deferred
(
$id
)
$defer
set ::redis::deferred
(
$id
)
$defer
set ::redis::reconnect
(
$id
)
0
set ::redis::reconnect
(
$id
)
0
set ::redis::tls $tls
::redis::redis_reset_state $id
::redis::redis_reset_state $id
interp alias
{}
::redis::redisHandle$id
{}
::redis::__dispatch__ $id
interp alias
{}
::redis::redisHandle$id
{}
::redis::__dispatch__ $id
}
}
...
@@ -72,7 +83,11 @@ proc ::redis::__dispatch__raw__ {id method argv} {
...
@@ -72,7 +83,11 @@ proc ::redis::__dispatch__raw__ {id method argv} {
# Reconnect the link if needed.
# Reconnect the link if needed.
if
{
$fd
eq
{}}
{
if
{
$fd
eq
{}}
{
lassign $::redis::addr
(
$id
)
host port
lassign $::redis::addr
(
$id
)
host port
set ::redis::fd
(
$id
)
[
socket $host $port
]
if
{
$::redis::tls
}
{
set ::redis::fd
(
$id
)
[
::tls::socket $host $port
]
}
else
{
set ::redis::fd
(
$id
)
[
socket $host $port
]
}
fconfigure $::redis::fd
(
$id
)
-translation binary
fconfigure $::redis::fd
(
$id
)
-translation binary
set fd $::redis::fd
(
$id
)
set fd $::redis::fd
(
$id
)
}
}
...
...
tests/support/server.tcl
View file @
8341a7d4
...
@@ -53,6 +53,7 @@ proc kill_server config {
...
@@ -53,6 +53,7 @@ proc kill_server config {
}
}
# kill server and wait for the process to be totally exited
# kill server and wait for the process to be totally exited
send_data_packet $::test_server_fd server-killing $pid
catch
{
exec kill $pid
}
catch
{
exec kill $pid
}
if
{
$::valgrind
}
{
if
{
$::valgrind
}
{
set max_wait 60000
set max_wait 60000
...
@@ -92,7 +93,11 @@ proc is_alive config {
...
@@ -92,7 +93,11 @@ proc is_alive config {
proc ping_server
{
host port
}
{
proc ping_server
{
host port
}
{
set retval 0
set retval 0
if
{[
catch
{
if
{[
catch
{
set fd
[
socket $host $port
]
if
{
$::tls
}
{
set fd
[
::tls::socket $host $port
]
}
else
{
set fd
[
socket $host $port
]
}
fconfigure $fd -translation binary
fconfigure $fd -translation binary
puts $fd
"PING
\r\n
"
puts $fd
"PING
\r\n
"
flush $fd
flush $fd
...
@@ -136,7 +141,6 @@ proc tags {tags code} {
...
@@ -136,7 +141,6 @@ proc tags {tags code} {
uplevel 1 $code
uplevel 1 $code
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
set ::tags
[
lrange $::tags 0 end-
[
llength $tags
]]
}
}
proc start_server
{
options
{
code undefined
}}
{
proc start_server
{
options
{
code undefined
}}
{
# If we are running against an external server, we just push the
# If we are running against an external server, we just push the
# host/port pair in the stack the first time
# host/port pair in the stack the first time
...
@@ -145,7 +149,7 @@ proc start_server {options {code undefined}} {
...
@@ -145,7 +149,7 @@ proc start_server {options {code undefined}} {
set srv
{}
set srv
{}
dict set srv
"host"
$::host
dict set srv
"host"
$::host
dict set srv
"port"
$::port
dict set srv
"port"
$::port
set client
[
redis $::host $::port
]
set client
[
redis $::host $::port
0 $::tls
]
dict set srv
"client"
$client
dict set srv
"client"
$client
$client select 9
$client select 9
...
@@ -178,6 +182,13 @@ proc start_server {options {code undefined}} {
...
@@ -178,6 +182,13 @@ proc start_server {options {code undefined}} {
set data
[
split
[
exec cat
"tests/assets/
$baseconfig
"
]
"
\n
"
]
set data
[
split
[
exec cat
"tests/assets/
$baseconfig
"
]
"
\n
"
]
set config
{}
set config
{}
if
{
$::tls
}
{
dict set config
"tls-cert-file"
[
format
"%s/tests/tls/redis.crt"
[
pwd
]]
dict set config
"tls-key-file"
[
format
"%s/tests/tls/redis.key"
[
pwd
]]
dict set config
"tls-dh-params-file"
[
format
"%s/tests/tls/redis.dh"
[
pwd
]]
dict set config
"tls-ca-cert-file"
[
format
"%s/tests/tls/ca.crt"
[
pwd
]]
dict set config
"loglevel"
"debug"
}
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
"#"
}
{
set elements
[
split $line
" "
]
set elements
[
split $line
" "
]
...
@@ -192,7 +203,17 @@ proc start_server {options {code undefined}} {
...
@@ -192,7 +203,17 @@ proc start_server {options {code undefined}} {
# start every server on a different port
# start every server on a different port
set ::port
[
find_available_port
[
expr
{
$::port
+1
}]]
set ::port
[
find_available_port
[
expr
{
$::port
+1
}]]
dict set config port $::port
if
{
$::tls
}
{
dict set config
"port"
0
dict set config
"tls-port"
$::port
dict set config
"tls-cluster"
"yes"
dict set config
"tls-replication"
"yes"
}
else
{
dict set config port $::port
}
set unixsocket
[
file normalize
[
format
"%s/%s"
[
dict get $config
"dir"
]
"socket"
]]
dict set config
"unixsocket"
$unixsocket
# apply overrides from global space and arguments
# apply overrides from global space and arguments
foreach
{
directive arguments
}
[
concat $::global_overrides $overrides
]
{
foreach
{
directive arguments
}
[
concat $::global_overrides $overrides
]
{
...
@@ -211,6 +232,8 @@ proc start_server {options {code undefined}} {
...
@@ -211,6 +232,8 @@ proc start_server {options {code undefined}} {
set stdout
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stdout"
]
set stdout
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stdout"
]
set stderr
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stderr"
]
set stderr
[
format
"%s/%s"
[
dict get $config
"dir"
]
"stderr"
]
send_data_packet $::test_server_fd
"server-spawning"
"port
$::port
"
if
{
$::valgrind
}
{
if
{
$::valgrind
}
{
set pid
[
exec valgrind --track-origins=yes --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &
]
set pid
[
exec valgrind --track-origins=yes --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &
]
}
elseif
(
$::stack
_logging
)
{
}
elseif
(
$::stack
_logging
)
{
...
@@ -248,16 +271,27 @@ proc start_server {options {code undefined}} {
...
@@ -248,16 +271,27 @@ proc start_server {options {code undefined}} {
}
}
# Wait for actual startup
# Wait for actual startup
set checkperiod 100
;
# Milliseconds
set maxiter
[
expr
{
120*1000/100
}]
;
# Wait up to 2 minutes.
while
{
!
[
info exists _pid
]}
{
while
{
!
[
info exists _pid
]}
{
regexp
{
PID:
\s
(
\d
+
)}
[
exec cat $stdout
]
_ _pid
regexp
{
PID:
\s
(
\d
+
)}
[
exec cat $stdout
]
_ _pid
after 100
after $checkperiod
incr maxiter -1
if
{
$maxiter
== 0
}
{
start_server_error $config_file
"No PID detected in log
$stdout
"
puts
"--- LOG CONTENT ---"
puts
[
exec cat $stdout
]
puts
"-------------------"
break
}
}
}
# setup properties to be able to initialize a client object
# setup properties to be able to initialize a client object
set port_param
[
expr $::tls ?
{
"tls-port"
}
:
{
"port"
}]
set host $::host
set host $::host
set port $::port
set port $::port
if
{[
dict exists $config bind
]}
{
set host
[
dict get $config bind
]
}
if
{[
dict exists $config bind
]}
{
set host
[
dict get $config bind
]
}
if
{[
dict exists $config port
]}
{
set port
[
dict get $config port
]
}
if
{[
dict exists $config
$
port
_param
]}
{
set port
[
dict get $config
$
port
_param
]
}
# setup config dict
# setup config dict
dict set srv
"config_file"
$config_file
dict set srv
"config_file"
$config_file
...
@@ -267,6 +301,7 @@ proc start_server {options {code undefined}} {
...
@@ -267,6 +301,7 @@ proc start_server {options {code undefined}} {
dict set srv
"port"
$port
dict set srv
"port"
$port
dict set srv
"stdout"
$stdout
dict set srv
"stdout"
$stdout
dict set srv
"stderr"
$stderr
dict set srv
"stderr"
$stderr
dict set srv
"unixsocket"
$unixsocket
# if a block of code is supplied, we wait for the server to become
# if a block of code is supplied, we wait for the server to become
# available, create a client object and kill the server afterwards
# available, create a client object and kill the server afterwards
...
...
tests/support/test.tcl
View file @
8341a7d4
...
@@ -11,22 +11,55 @@ proc fail {msg} {
...
@@ -11,22 +11,55 @@ proc fail {msg} {
proc assert
{
condition
}
{
proc assert
{
condition
}
{
if
{
!
[
uplevel 1
[
list expr $condition
]]}
{
if
{
!
[
uplevel 1
[
list expr $condition
]]}
{
error
"assertion:Expected condition '
$condition
' to be true (
[
uplevel 1
[
list subst -nocommands $condition
]]
)"
set context
"(context:
[
info frame -1
]
)"
error
"assertion:Expected
[
uplevel 1
[
list subst -nocommands $condition
]]
$context
"
}
}
proc assert_no_match
{
pattern value
}
{
if
{[
string match $pattern $value
]}
{
set context
"(context:
[
info frame -1
]
)"
error
"assertion:Expected '
$value
' to not match '
$pattern
'
$context
"
}
}
}
}
proc assert_match
{
pattern value
}
{
proc assert_match
{
pattern value
}
{
if
{
!
[
string match $pattern $value
]}
{
if
{
!
[
string match $pattern $value
]}
{
error
"assertion:Expected '
$value
' to match '
$pattern
'"
set context
"(context:
[
info frame -1
]
)"
error
"assertion:Expected '
$value
' to match '
$pattern
'
$context
"
}
}
}
}
proc assert_equal
{
expected
value
{
detail
""
}}
{
proc assert_equal
{
value
expected
{
detail
""
}}
{
if
{
$expected
ne $value
}
{
if
{
$expected
ne $value
}
{
if
{
$detail
ne
""
}
{
if
{
$detail
ne
""
}
{
set detail
" (detail:
$detail
)"
set detail
"(detail:
$detail
)"
}
else
{
set detail
"(context:
[
info frame -1
]
)"
}
error
"assertion:Expected '
$value
' to be equal to '
$expected
'
$detail
"
}
}
proc assert_lessthan
{
value expected
{
detail
""
}}
{
if
{
!
(
$value
< $expected
)}
{
if
{
$detail
ne
""
}
{
set detail
"(detail:
$detail
)"
}
else
{
set detail
"(context:
[
info frame -1
]
)"
}
error
"assertion:Expected '
$value
' to be lessthan to '
$expected
'
$detail
"
}
}
proc assert_range
{
value min max
{
detail
""
}}
{
if
{
!
(
$value
<= $max && $value >= $min
)}
{
if
{
$detail
ne
""
}
{
set detail
"(detail:
$detail
)"
}
else
{
set detail
"(context:
[
info frame -1
]
)"
}
}
error
"assertion:Expected '
$value
' to be
equal to '
$expected
'
$detail
"
error
"assertion:Expected '
$value
' to be
between to '
$min
' and '
$max
'
$detail
"
}
}
}
}
...
...
tests/support/util.tcl
View file @
8341a7d4
...
@@ -99,6 +99,25 @@ proc wait_for_ofs_sync {r1 r2} {
...
@@ -99,6 +99,25 @@ proc wait_for_ofs_sync {r1 r2} {
}
}
}
}
proc wait_for_log_message
{
srv_idx pattern last_lines maxtries delay
}
{
set retry $maxtries
set stdout
[
srv $srv_idx stdout
]
while
{
$retry
}
{
set result
[
exec tail -$last_lines < $stdout
]
set result
[
split $result
"
\n
"
]
foreach line $result
{
if
{[
string match $pattern $line
]}
{
return $line
}
}
incr retry -1
after $delay
}
if
{
$retry
== 0
}
{
fail
"log message of '
$pattern
' not found"
}
}
# Random integer between 0 and max
(
excluded
)
.
# Random integer between 0 and max
(
excluded
)
.
proc randomInt
{
max
}
{
proc randomInt
{
max
}
{
expr
{
int
(
rand
()
*$max
)}
expr
{
int
(
rand
()
*$max
)}
...
@@ -376,7 +395,7 @@ proc colorstr {color str} {
...
@@ -376,7 +395,7 @@ proc colorstr {color str} {
# of seconds to the specified Redis instance.
# of seconds to the specified Redis instance.
proc start_write_load
{
host port seconds
}
{
proc start_write_load
{
host port seconds
}
{
set tclsh
[
info nameofexecutable
]
set tclsh
[
info nameofexecutable
]
exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds &
exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds
$::tls
&
}
}
# Stop a process generating write load executed with start_write_load.
# Stop a process generating write load executed with start_write_load.
...
@@ -399,3 +418,15 @@ proc lshuffle {list} {
...
@@ -399,3 +418,15 @@ proc lshuffle {list} {
}
}
return $slist
return $slist
}
}
# Execute a background process writing complex data for the specified number
# of ops to the specified Redis instance.
proc start_bg_complex_data
{
host port db ops
}
{
set tclsh
[
info nameofexecutable
]
exec $tclsh tests/helpers/bg_complex_data.tcl $host $port $db $ops $::tls &
}
# Stop a process generating write load executed with start_bg_complex_data.
proc stop_bg_complex_data
{
handle
}
{
catch
{
exec /bin/kill -9 $handle
}
}
tests/test_helper.tcl
View file @
8341a7d4
...
@@ -63,6 +63,7 @@ set ::all_tests {
...
@@ -63,6 +63,7 @@ set ::all_tests {
unit/lazyfree
unit/lazyfree
unit/wait
unit/wait
unit/pendingquerybuf
unit/pendingquerybuf
unit/tls
}
}
# Index to the next test to run in the ::all_tests list.
# Index to the next test to run in the ::all_tests list.
set ::next_test 0
set ::next_test 0
...
@@ -71,6 +72,7 @@ set ::host 127.0.0.1
...
@@ -71,6 +72,7 @@ set ::host 127.0.0.1
set ::port 21111
set ::port 21111
set ::traceleaks 0
set ::traceleaks 0
set ::valgrind 0
set ::valgrind 0
set ::tls 0
set ::stack_logging 0
set ::stack_logging 0
set ::verbose 0
set ::verbose 0
set ::quiet 0
set ::quiet 0
...
@@ -85,13 +87,14 @@ set ::file ""; # If set, runs only the tests in this comma separated list
...
@@ -85,13 +87,14 @@ set ::file ""; # If set, runs only the tests in this comma separated list
set ::curfile
""
;
# Hold the filename of the current suite
set ::curfile
""
;
# Hold the filename of the current suite
set ::accurate 0
;
# If true runs fuzz tests with more iterations
set ::accurate 0
;
# If true runs fuzz tests with more iterations
set ::force_failure 0
set ::force_failure 0
set ::timeout
6
00
;
#
1
0 minutes without progresses will quit the test.
set ::timeout
12
00
;
#
2
0 minutes without progresses will quit the test.
set ::last_progress
[
clock seconds
]
set ::last_progress
[
clock seconds
]
set ::active_servers
{}
;
# Pids of active Redis instances.
set ::active_servers
{}
;
# Pids of active Redis instances.
set ::dont_clean 0
set ::dont_clean 0
set ::wait_server 0
set ::wait_server 0
set ::stop_on_failure 0
set ::stop_on_failure 0
set ::loop 0
set ::loop 0
set ::tlsdir
"tests/tls"
# Set to 1 when we are running in client mode. The Redis test uses a
# Set to 1 when we are running in client mode. The Redis test uses a
# server-client model to run tests simultaneously. The server instance
# server-client model to run tests simultaneously. The server instance
...
@@ -146,7 +149,7 @@ proc reconnect {args} {
...
@@ -146,7 +149,7 @@ proc reconnect {args} {
set host
[
dict get $srv
"host"
]
set host
[
dict get $srv
"host"
]
set port
[
dict get $srv
"port"
]
set port
[
dict get $srv
"port"
]
set config
[
dict get $srv
"config"
]
set config
[
dict get $srv
"config"
]
set client
[
redis $host $port
]
set client
[
redis $host $port
0 $::tls
]
dict set srv
"client"
$client
dict set srv
"client"
$client
# select the right db when we don't have to authenticate
# select the right db when we don't have to authenticate
...
@@ -166,7 +169,7 @@ proc redis_deferring_client {args} {
...
@@ -166,7 +169,7 @@ proc redis_deferring_client {args} {
}
}
# create client that defers reading reply
# create client that defers reading reply
set client
[
redis
[
srv $level
"host"
]
[
srv $level
"port"
]
1
]
set client
[
redis
[
srv $level
"host"
]
[
srv $level
"port"
]
1
$::tls
]
# select the right db and read the response
(
OK
)
# select the right db and read the response
(
OK
)
$client select 9
$client select 9
...
@@ -204,7 +207,7 @@ proc test_server_main {} {
...
@@ -204,7 +207,7 @@ proc test_server_main {} {
if
{
!$::quiet
}
{
if
{
!$::quiet
}
{
puts
"Starting test server at port
$port
"
puts
"Starting test server at port
$port
"
}
}
socket -server accept_test_clients -myaddr 127.0.0.1 $port
socket -server accept_test_clients
-myaddr 127.0.0.1 $port
# Start the client instances
# Start the client instances
set ::clients_pids
{}
set ::clients_pids
{}
...
@@ -286,7 +289,7 @@ proc read_from_test_client fd {
...
@@ -286,7 +289,7 @@ proc read_from_test_client fd {
puts
"
\[
$completed
_tests_count/
$all
_tests_count
[
colorstr yellow $status
]
\]
:
$data
(
$elapsed
seconds)"
puts
"
\[
$completed
_tests_count/
$all
_tests_count
[
colorstr yellow $status
]
\]
:
$data
(
$elapsed
seconds)"
lappend ::clients_time_history $elapsed $data
lappend ::clients_time_history $elapsed $data
signal_idle_client $fd
signal_idle_client $fd
set ::active_clients_task
(
$fd
)
DONE
set ::active_clients_task
(
$fd
)
"(
DONE
)
$data
"
}
elseif
{
$status
eq
{
ok
}}
{
}
elseif
{
$status
eq
{
ok
}}
{
if
{
!$::quiet
}
{
if
{
!$::quiet
}
{
puts
"
\[
[
colorstr green $status
]
\]
:
$data
"
puts
"
\[
[
colorstr green $status
]
\]
:
$data
"
...
@@ -317,10 +320,16 @@ proc read_from_test_client fd {
...
@@ -317,10 +320,16 @@ proc read_from_test_client fd {
exit 1
exit 1
}
elseif
{
$status
eq
{
testing
}}
{
}
elseif
{
$status
eq
{
testing
}}
{
set ::active_clients_task
(
$fd
)
"(IN PROGRESS)
$data
"
set ::active_clients_task
(
$fd
)
"(IN PROGRESS)
$data
"
}
elseif
{
$status
eq
{
server-spawning
}}
{
set ::active_clients_task
(
$fd
)
"(SPAWNING SERVER)
$data
"
}
elseif
{
$status
eq
{
server-spawned
}}
{
}
elseif
{
$status
eq
{
server-spawned
}}
{
lappend ::active_servers $data
lappend ::active_servers $data
set ::active_clients_task
(
$fd
)
"(SPAWNED SERVER) pid:
$data
"
}
elseif
{
$status
eq
{
server-killing
}}
{
set ::active_clients_task
(
$fd
)
"(KILLING SERVER) pid:
$data
"
}
elseif
{
$status
eq
{
server-killed
}}
{
}
elseif
{
$status
eq
{
server-killed
}}
{
set ::active_servers
[
lsearch -all -inline -not -exact $::active_servers $data
]
set ::active_servers
[
lsearch -all -inline -not -exact $::active_servers $data
]
set ::active_clients_task
(
$fd
)
"(KILLED SERVER) pid:
$data
"
}
else
{
}
else
{
if
{
!$::quiet
}
{
if
{
!$::quiet
}
{
puts
"
\[
$status
\]
:
$data
"
puts
"
\[
$status
\]
:
$data
"
...
@@ -330,7 +339,7 @@ proc read_from_test_client fd {
...
@@ -330,7 +339,7 @@ proc read_from_test_client fd {
proc show_clients_state
{}
{
proc show_clients_state
{}
{
# The following loop is only useful for debugging tests that may
# The following loop is only useful for debugging tests that may
# enter an infinite loop.
Commented out normally.
# enter an infinite loop.
foreach x $::active_clients
{
foreach x $::active_clients
{
if
{[
info exist ::active_clients_task
(
$x
)]}
{
if
{[
info exist ::active_clients_task
(
$x
)]}
{
puts
"
$x
=>
$::active
_clients_task(
$x
)"
puts
"
$x
=>
$::active
_clients_task(
$x
)"
...
@@ -360,8 +369,6 @@ proc signal_idle_client fd {
...
@@ -360,8 +369,6 @@ proc signal_idle_client fd {
set ::active_clients
\
set ::active_clients
\
[
lsearch -all -inline -not -exact $::active_clients $fd
]
[
lsearch -all -inline -not -exact $::active_clients $fd
]
if 0
{
show_clients_state
}
# New unit to process?
# New unit to process?
if
{
$::next
_test !=
[
llength $::all_tests
]}
{
if
{
$::next
_test !=
[
llength $::all_tests
]}
{
if
{
!$::quiet
}
{
if
{
!$::quiet
}
{
...
@@ -377,6 +384,7 @@ proc signal_idle_client fd {
...
@@ -377,6 +384,7 @@ proc signal_idle_client fd {
}
}
}
else
{
}
else
{
lappend ::idle_clients $fd
lappend ::idle_clients $fd
set ::active_clients_task
(
$fd
)
"SLEEPING, no more units to assign"
if
{[
llength $::active_clients
]
== 0
}
{
if
{[
llength $::active_clients
]
== 0
}
{
the_end
the_end
}
}
...
@@ -450,6 +458,7 @@ proc print_help_screen {} {
...
@@ -450,6 +458,7 @@ proc print_help_screen {} {
"--stop Blocks once the first test fails."
"--stop Blocks once the first test fails."
"--loop Execute the specified set of tests forever."
"--loop Execute the specified set of tests forever."
"--wait-server Wait after server is started (so that you can attach a debugger)."
"--wait-server Wait after server is started (so that you can attach a debugger)."
"--tls Run tests in TLS mode."
"--help Print this help screen."
"--help Print this help screen."
}
"
\n
"
]
}
"
\n
"
]
}
}
...
@@ -486,6 +495,13 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
...
@@ -486,6 +495,13 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
}
}
}
elseif
{
$opt
eq
{
--quiet
}}
{
}
elseif
{
$opt
eq
{
--quiet
}}
{
set ::quiet 1
set ::quiet 1
}
elseif
{
$opt
eq
{
--tls
}}
{
package require tls 1.6
set ::tls 1
::tls::init
\
-cafile
"
$::tlsdir
/ca.crt"
\
-certfile
"
$::tlsdir
/redis.crt"
\
-keyfile
"
$::tlsdir
/redis.key"
}
elseif
{
$opt
eq
{
--host
}}
{
}
elseif
{
$opt
eq
{
--host
}}
{
set ::external 1
set ::external 1
set ::host $arg
set ::host $arg
...
@@ -503,7 +519,7 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
...
@@ -503,7 +519,7 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
}
elseif
{
$opt
eq
{
--only
}}
{
}
elseif
{
$opt
eq
{
--only
}}
{
lappend ::only_tests $arg
lappend ::only_tests $arg
incr j
incr j
}
elseif
{
$opt
eq
{
--skiptill
}}
{
}
elseif
{
$opt
eq
{
--skip
-
till
}}
{
set ::skip_till $arg
set ::skip_till $arg
incr j
incr j
}
elseif
{
$opt
eq
{
--list-tests
}}
{
}
elseif
{
$opt
eq
{
--list-tests
}}
{
...
@@ -565,7 +581,11 @@ if {[llength $::single_tests] > 0} {
...
@@ -565,7 +581,11 @@ if {[llength $::single_tests] > 0} {
}
}
proc attach_to_replication_stream
{}
{
proc attach_to_replication_stream
{}
{
set s
[
socket
[
srv 0
"host"
]
[
srv 0
"port"
]]
if
{
$::tls
}
{
set s
[
::tls::socket
[
srv 0
"host"
]
[
srv 0
"port"
]]
}
else
{
set s
[
socket
[
srv 0
"host"
]
[
srv 0
"port"
]]
}
fconfigure $s -translation binary
fconfigure $s -translation binary
puts -nonewline $s
"SYNC
\r\n
"
puts -nonewline $s
"SYNC
\r\n
"
flush $s
flush $s
...
...
tests/unit/acl.tcl
View file @
8341a7d4
...
@@ -35,6 +35,32 @@ start_server {tags {"acl"}} {
...
@@ -35,6 +35,32 @@ start_server {tags {"acl"}} {
set e
set e
}
{
*WRONGPASS*
}
}
{
*WRONGPASS*
}
test
{
Test password hashes can be added
}
{
r ACL setuser newuser #34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4e6
catch
{
r AUTH newuser passwd4
}
e
assert
{
$e
eq
"OK"
}
}
test
{
Test password hashes validate input
}
{
# Validate Length
catch
{
r ACL setuser newuser #34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4e
}
e
# Validate character outside set
catch
{
r ACL setuser newuser #34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4eq
}
e
set e
}
{
*Error in ACL SETUSER modifier*
}
test
{
ACL GETUSER returns the password hash instead of the actual password
}
{
set passstr
[
dict get
[
r ACL getuser newuser
]
passwords
]
assert_match
{
*34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4e6*
}
$passstr
assert_no_match
{
*passwd4*
}
$passstr
}
test
{
Test hashed passwords removal
}
{
r ACL setuser newuser !34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4e6
set passstr
[
dict get
[
r ACL getuser newuser
]
passwords
]
assert_no_match
{
*34344e4d60c2b6d639b7bd22e18f2b0b91bc34bf0ac5f9952744435093cfb4e6*
}
$passstr
}
test
{
By default users are not able to access any command
}
{
test
{
By default users are not able to access any command
}
{
catch
{
r SET foo bar
}
e
catch
{
r SET foo bar
}
e
set e
set e
...
@@ -67,7 +93,7 @@ start_server {tags {"acl"}} {
...
@@ -67,7 +93,7 @@ start_server {tags {"acl"}} {
set e
set e
}
{
*NOPERM*
}
}
{
*NOPERM*
}
test
{
ACLs can include or exclu
s
e whole classes of commands
}
{
test
{
ACLs can include or exclu
d
e whole classes of commands
}
{
r ACL setuser newuser -@all +@set +acl
r ACL setuser newuser -@all +@set +acl
r SADD myset a b c
;
# Should not raise an error
r SADD myset a b c
;
# Should not raise an error
r ACL setuser newuser +@all -@string
r ACL setuser newuser +@all -@string
...
@@ -108,4 +134,118 @@ start_server {tags {"acl"}} {
...
@@ -108,4 +134,118 @@ start_server {tags {"acl"}} {
assert_match
{
*+debug|segfault*
}
$cmdstr
assert_match
{
*+debug|segfault*
}
$cmdstr
assert_match
{
*+acl*
}
$cmdstr
assert_match
{
*+acl*
}
$cmdstr
}
}
test
{
ACL #5998 regression: memory leaks adding / removing subcommands
}
{
r AUTH default
""
r ACL setuser newuser reset -debug +debug|a +debug|b +debug|c
r ACL setuser newuser -debug
# The test framework will detect a leak if any.
}
test
{
ACL LOG shows failed command executions at toplevel
}
{
r ACL LOG RESET
r ACL setuser antirez >foo on +set ~object:1234
r ACL setuser antirez +eval +multi +exec
r AUTH antirez foo
catch
{
r GET foo
}
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry username
]
eq
{
antirez
}}
assert
{[
dict get $entry context
]
eq
{
toplevel
}}
assert
{[
dict get $entry reason
]
eq
{
command
}}
assert
{[
dict get $entry object
]
eq
{
get
}}
}
test
{
ACL LOG is able to test similar events
}
{
r AUTH antirez foo
catch
{
r GET foo
}
catch
{
r GET foo
}
catch
{
r GET foo
}
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry count
]
== 4
}
}
test
{
ACL LOG is able to log keys access violations and key name
}
{
r AUTH antirez foo
catch
{
r SET somekeynotallowed 1234
}
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry reason
]
eq
{
key
}}
assert
{[
dict get $entry object
]
eq
{
somekeynotallowed
}}
}
test
{
ACL LOG RESET is able to flush the entries in the log
}
{
r ACL LOG RESET
assert
{[
llength
[
r ACL LOG
]]
== 0
}
}
test
{
ACL LOG can distinguish the transaction context
(
1
)}
{
r AUTH antirez foo
r MULTI
catch
{
r INCR foo
}
catch
{
r EXEC
}
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry context
]
eq
{
multi
}}
assert
{[
dict get $entry object
]
eq
{
incr
}}
}
test
{
ACL LOG can distinguish the transaction context
(
2
)}
{
set rd1
[
redis_deferring_client
]
r ACL SETUSER antirez +incr
r AUTH antirez foo
r MULTI
r INCR object:1234
$rd1 ACL SETUSER antirez -incr
$rd1 read
catch
{
r EXEC
}
$rd1 close
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry context
]
eq
{
multi
}}
assert
{[
dict get $entry object
]
eq
{
incr
}}
r ACL SETUSER antirez -incr
}
test
{
ACL can log errors in the context of Lua scripting
}
{
r AUTH antirez foo
catch
{
r EVAL
{
redis.call
(
'incr','foo'
)}
0
}
r AUTH default
""
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry context
]
eq
{
lua
}}
assert
{[
dict get $entry object
]
eq
{
incr
}}
}
test
{
ACL LOG can accept a numerical argument to show less entries
}
{
r AUTH antirez foo
catch
{
r INCR foo
}
catch
{
r INCR foo
}
catch
{
r INCR foo
}
catch
{
r INCR foo
}
r AUTH default
""
assert
{[
llength
[
r ACL LOG
]]
> 1
}
assert
{[
llength
[
r ACL LOG 2
]]
== 2
}
}
test
{
ACL LOG can log failed auth attempts
}
{
catch
{
r AUTH antirez wrong-password
}
set entry
[
lindex
[
r ACL LOG
]
0
]
assert
{[
dict get $entry context
]
eq
{
toplevel
}}
assert
{[
dict get $entry reason
]
eq
{
auth
}}
assert
{[
dict get $entry object
]
eq
{
AUTH
}}
assert
{[
dict get $entry username
]
eq
{
antirez
}}
}
test
{
ACL LOG entries are limited to a maximum amount
}
{
r ACL LOG RESET
r CONFIG SET acllog-max-len 5
r AUTH antirez foo
for
{
set j 0
}
{
$j
< 10
}
{
incr j
}
{
catch
{
r SET obj:$j 123
}
}
r AUTH default
""
assert
{[
llength
[
r ACL LOG
]]
== 5
}
}
}
}
tests/unit/expire.tcl
View file @
8341a7d4
...
@@ -219,4 +219,17 @@ start_server {tags {"expire"}} {
...
@@ -219,4 +219,17 @@ start_server {tags {"expire"}} {
set ttl
[
r ttl foo
]
set ttl
[
r ttl foo
]
assert
{
$ttl
<= 98 && $ttl > 90
}
assert
{
$ttl
<= 98 && $ttl > 90
}
}
}
test
{
SET command will remove expire
}
{
r set foo bar EX 100
r set foo bar
r ttl foo
}
{
-1
}
test
{
SET - use KEEPTTL option, TTL should not be removed
}
{
r set foo bar EX 100
r set foo bar KEEPTTL
set ttl
[
r ttl foo
]
assert
{
$ttl
<= 100 && $ttl > 90
}
}
}
}
tests/unit/geo.tcl
View file @
8341a7d4
...
@@ -61,6 +61,7 @@ set regression_vectors {
...
@@ -61,6 +61,7 @@ set regression_vectors {
{
939895 151 59.149620271823181 65.204186651485145
}
{
939895 151 59.149620271823181 65.204186651485145
}
{
1412 156 149.29737817929004 15.95807862745508
}
{
1412 156 149.29737817929004 15.95807862745508
}
{
564862 149 84.062063109158544 -65.685403922426232
}
{
564862 149 84.062063109158544 -65.685403922426232
}
{
1546032440391 16751 -1.8175081637769495 20.665668878082954
}
}
}
set rv_idx 0
set rv_idx 0
...
@@ -274,8 +275,19 @@ start_server {tags {"geo"}} {
...
@@ -274,8 +275,19 @@ start_server {tags {"geo"}} {
foreach place $diff
{
foreach place $diff
{
set mydist
[
geo_distance $lon $lat $search_lon $search_lat
]
set mydist
[
geo_distance $lon $lat $search_lon $search_lat
]
set mydist
[
expr $mydist/1000
]
set mydist
[
expr $mydist/1000
]
if
{(
$mydist
/ $radius_km
)
> 0.999
}
{
incr rounding_errors
}
if
{(
$mydist
/ $radius_km
)
> 0.999
}
{
incr rounding_errors
continue
}
if
{
$mydist
< $radius_m
}
{
# This is a false positive for redis since given the
# same points the higher precision calculation provided
# by TCL shows the point within range
incr rounding_errors
continue
}
}
}
# Make sure this is a real error and not a rounidng issue.
# Make sure this is a real error and not a rounidng issue.
if
{[
llength $diff
]
== $rounding_errors
}
{
if
{[
llength $diff
]
== $rounding_errors
}
{
set res $res2
;
# Error silenced
set res $res2
;
# Error silenced
...
...
tests/unit/hyperloglog.tcl
View file @
8341a7d4
...
@@ -115,6 +115,34 @@ start_server {tags {"hll"}} {
...
@@ -115,6 +115,34 @@ start_server {tags {"hll"}} {
set e
set e
}
{
*WRONGTYPE*
}
}
{
*WRONGTYPE*
}
test
{
Fuzzing dense/sparse encoding: Redis should always detect errors
}
{
for
{
set j 0
}
{
$j
< 1000
}
{
incr j
}
{
r del hll
set items
{}
set numitems
[
randomInt 3000
]
for
{
set i 0
}
{
$i
< $numitems
}
{
incr i
}
{
lappend items
[
expr
{
rand
()}]
}
r pfadd hll
{*}
$items
# Corrupt it in some random way.
for
{
set i 0
}
{
$i
< 5
}
{
incr i
}
{
set len
[
r strlen hll
]
set pos
[
randomInt $len
]
set byte
[
randstring 1 1 binary
]
r setrange hll $pos $byte
# Don't modify more bytes 50% of times
if
{
rand
()
< 0.5
}
break
}
# Use the hyperloglog to check if it crashes
# Redis in some way.
catch
{
r pfcount hll
}
}
}
test
{
PFADD, PFCOUNT, PFMERGE type checking works
}
{
test
{
PFADD, PFCOUNT, PFMERGE type checking works
}
{
r set foo bar
r set foo bar
catch
{
r pfadd foo 1
}
e
catch
{
r pfadd foo 1
}
e
...
...
tests/unit/introspection.tcl
View file @
8341a7d4
...
@@ -57,4 +57,69 @@ start_server {tags {"introspection"}} {
...
@@ -57,4 +57,69 @@ start_server {tags {"introspection"}} {
fail
"Client still listed in CLIENT LIST after SETNAME."
fail
"Client still listed in CLIENT LIST after SETNAME."
}
}
}
}
test
{
CONFIG sanity
}
{
# Do CONFIG GET, CONFIG SET and then CONFIG GET again
# Skip immutable configs, one with no get, and other complicated configs
set skip_configs
{
rdbchecksum
daemonize
io-threads-do-reads
tcp-backlog
always-show-logo
syslog-enabled
cluster-enabled
aclfile
unixsocket
pidfile
syslog-ident
appendfilename
supervised
syslog-facility
databases
port
io-threads
tls-port
tls-prefer-server-ciphers
tls-cert-file
tls-key-file
tls-dh-params-file
tls-ca-cert-file
tls-ca-cert-dir
tls-protocols
tls-ciphers
tls-ciphersuites
logfile
unixsocketperm
slaveof
bind
requirepass
}
set configs
{}
foreach
{
k v
}
[
r config get *
]
{
if
{[
lsearch $skip_configs $k
]
!= -1
}
{
continue
}
dict set configs $k $v
# try to set the config to the same value it already has
r config set $k $v
}
set newconfigs
{}
foreach
{
k v
}
[
r config get *
]
{
if
{[
lsearch $skip_configs $k
]
!= -1
}
{
continue
}
dict set newconfigs $k $v
}
dict for
{
k v
}
$configs
{
set vv
[
dict get $newconfigs $k
]
if
{
$v
!= $vv
}
{
fail
"config
$k
mismatch, expecting
$v
but got
$vv
"
}
}
}
}
}
tests/unit/limits.tcl
View file @
8341a7d4
start_server
{
tags
{
"limits"
}
overrides
{
maxclients 10
}}
{
start_server
{
tags
{
"limits"
}
overrides
{
maxclients 10
}}
{
if
{
$::tls
}
{
set expected_code
"*I/O error*"
}
else
{
set expected_code
"*ERR max*reached*"
}
test
{
Check if maxclients works refusing connections
}
{
test
{
Check if maxclients works refusing connections
}
{
set c 0
set c 0
catch
{
catch
{
...
@@ -12,5 +17,5 @@ start_server {tags {"limits"} overrides {maxclients 10}} {
...
@@ -12,5 +17,5 @@ start_server {tags {"limits"} overrides {maxclients 10}} {
}
e
}
e
assert
{
$c
> 8 && $c <= 10
}
assert
{
$c
> 8 && $c <= 10
}
set e
set e
}
{
*ERR max*reached*
}
}
$expected_code
}
}
tests/unit/maxmemory.tcl
View file @
8341a7d4
...
@@ -161,7 +161,7 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
...
@@ -161,7 +161,7 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
}
}
# make sure master doesn't disconnect slave because of timeout
# make sure master doesn't disconnect slave because of timeout
$master config set repl-timeout
3
00
;
#
5
minutes
$master config set repl-timeout
12
00
;
#
20
minutes
(
for valgrind and slow machines
)
$master config set maxmemory-policy allkeys-random
$master config set maxmemory-policy allkeys-random
$master config set client-output-buffer-limit
"replica 100000000 100000000 300"
$master config set client-output-buffer-limit
"replica 100000000 100000000 300"
$master config set repl-backlog-size
[
expr
{
10*1024
}]
$master config set repl-backlog-size
[
expr
{
10*1024
}]
...
@@ -212,7 +212,8 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
...
@@ -212,7 +212,8 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
assert
{[
$master
dbsize
]
== 100
}
assert
{[
$master
dbsize
]
== 100
}
assert
{
$slave
_buf > 2*1024*1024
}
;
# some of the data may have been pushed to the OS buffers
assert
{
$slave
_buf > 2*1024*1024
}
;
# some of the data may have been pushed to the OS buffers
assert
{
$delta
< 50*1024 && $delta > -50*1024
}
;
# 1 byte unaccounted for, with 1M commands will consume some 1MB
set delta_max
[
expr
{
$cmd
_count / 2
}]
;
# 1 byte unaccounted for, with 1M commands will consume some 1MB
assert
{
$delta
< $delta_max && $delta > -$delta_max
}
$master client kill type slave
$master client kill type slave
set killed_used
[
s -1 used_memory
]
set killed_used
[
s -1 used_memory
]
...
@@ -221,7 +222,7 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
...
@@ -221,7 +222,7 @@ proc test_slave_buffers {test_name cmd_count payload_len limit_memory pipeline}
set killed_used_no_repl
[
expr
{
$killed
_used - $killed_mem_not_counted_for_evict
}]
set killed_used_no_repl
[
expr
{
$killed
_used - $killed_mem_not_counted_for_evict
}]
set delta_no_repl
[
expr
{
$killed
_used_no_repl - $used_no_repl
}]
set delta_no_repl
[
expr
{
$killed
_used_no_repl - $used_no_repl
}]
assert
{
$killed
_slave_buf == 0
}
assert
{
$killed
_slave_buf == 0
}
assert
{
$delta
_no_repl > -
50*1024
&& $delta_no_repl <
50*1024
}
;
# 1 byte unaccounted for, with 1M commands will consume some 1MB
assert
{
$delta
_no_repl > -
$delta_max
&& $delta_no_repl <
$delta_max
}
}
}
# unfreeze slave process
(
after the 'test' succeeded or failed, but before we attempt to terminate the server
# unfreeze slave process
(
after the 'test' succeeded or failed, but before we attempt to terminate the server
...
...
tests/unit/memefficiency.tcl
View file @
8341a7d4
...
@@ -209,5 +209,97 @@ start_server {tags {"defrag"}} {
...
@@ -209,5 +209,97 @@ start_server {tags {"defrag"}} {
assert
{
$digest
eq $newdigest
}
assert
{
$digest
eq $newdigest
}
r save
;
# saving an rdb iterates over all the data / pointers
r save
;
# saving an rdb iterates over all the data / pointers
}
{
OK
}
}
{
OK
}
test
"Active defrag big list"
{
r flushdb
r config resetstat
r config set save
""
;
# prevent bgsave from interfereing with save below
r config set hz 100
r config set activedefrag no
r config set active-defrag-max-scan-fields 1000
r config set active-defrag-threshold-lower 5
r config set active-defrag-cycle-min 65
r config set active-defrag-cycle-max 75
r config set active-defrag-ignore-bytes 2mb
r config set maxmemory 0
r config set list-max-ziplist-size 5
;
# list of 500k items will have 100k quicklist nodes
# create big keys with 10k items
set rd
[
redis_deferring_client
]
set expected_frag 1.7
# add a mass of list nodes to two lists
(
allocations are interlaced
)
set val
[
string repeat A 100
]
;
# 5 items of 100 bytes puts us in the 640 bytes bin, which has 32 regs, so high potential for fragmentation
for
{
set j 0
}
{
$j
< 500000
}
{
incr j
}
{
$rd lpush biglist1 $val
$rd lpush biglist2 $val
}
for
{
set j 0
}
{
$j
< 500000
}
{
incr j
}
{
$rd read
;
# Discard replies
$rd read
;
# Discard replies
}
# create some fragmentation
r del biglist2
# start defrag
after 120
;
# serverCron only updates the info once in 100ms
set frag
[
s allocator_frag_ratio
]
if
{
$::verbose
}
{
puts
"frag
$frag
"
}
assert
{
$frag
>= $expected_frag
}
r config set latency-monitor-threshold 5
r latency reset
set digest
[
r debug digest
]
catch
{
r config set activedefrag yes
}
e
if
{
!
[
string match
{
DISABLED*
}
$e
]}
{
# wait for the active defrag to start working
(
decision once a second
)
wait_for_condition 50 100
{
[
s active_defrag_running
]
ne 0
}
else
{
fail
"defrag not started."
}
# wait for the active defrag to stop working
wait_for_condition 500 100
{
[
s active_defrag_running
]
eq 0
}
else
{
after 120
;
# serverCron only updates the info once in 100ms
puts
[
r info memory
]
puts
[
r info stats
]
puts
[
r memory malloc-stats
]
fail
"defrag didn't stop."
}
# test the the fragmentation is lower
after 120
;
# serverCron only updates the info once in 100ms
set frag
[
s allocator_frag_ratio
]
set max_latency 0
foreach event
[
r latency latest
]
{
lassign $event eventname time latency max
if
{
$eventname
==
"active-defrag-cycle"
}
{
set max_latency $max
}
}
if
{
$::verbose
}
{
puts
"frag
$frag
"
puts
"max latency
$max
_latency"
puts
[
r latency latest
]
puts
[
r latency history active-defrag-cycle
]
}
assert
{
$frag
< 1.1
}
# due to high fragmentation, 100hz, and active-defrag-cycle-max set to 75,
# we expect max latency to be not much higher than 7.5ms
assert
{
$max
_latency <= 12
}
}
# verify the data isn't corrupted or changed
set newdigest
[
r debug digest
]
assert
{
$digest
eq $newdigest
}
r save
;
# saving an rdb iterates over all the data / pointers
r del biglist1
;
# coverage for quicklistBookmarksClear
}
{
1
}
}
}
}
}
tests/unit/moduleapi/auth.tcl
0 → 100644
View file @
8341a7d4
set testmodule
[
file normalize tests/modules/auth.so
]
start_server
{
tags
{
"modules"
}}
{
r module load $testmodule
test
{
Modules can create a user that can be authenticated
}
{
# Make sure we start authenticated with default user
r auth default
""
assert_equal
[
r acl whoami
]
"default"
r auth.createmoduleuser
set id
[
r auth.authmoduleuser
]
assert_equal
[
r client id
]
$id
# Verify returned id is the same as our current id and
# we are authenticated with the specified user
assert_equal
[
r acl whoami
]
"global"
}
test
{
De-authenticating clients is tracked and kills clients
}
{
assert_equal
[
r auth.changecount
]
0
r auth.createmoduleuser
# Catch the I/O exception that was thrown when Redis
# disconnected with us.
catch
{
[
r ping
]
}
e
assert_match
{
*I/O*
}
$e
# Check that a user change was registered
assert_equal
[
r auth.changecount
]
1
}
test
{
Modules cant authenticate with ACLs users that dont exist
}
{
catch
{
[
r auth.authrealuser auth-module-test-fake
]
}
e
assert_match
{
*Invalid user*
}
$e
}
test
{
Modules can authenticate with ACL users
}
{
assert_equal
[
r acl whoami
]
"default"
# Create user to auth into
r acl setuser auth-module-test on allkeys allcommands
set id
[
r auth.authrealuser auth-module-test
]
# Verify returned id is the same as our current id and
# we are authenticated with the specified user
assert_equal
[
r client id
]
$id
assert_equal
[
r acl whoami
]
"auth-module-test"
}
test
{
Client callback is called on user switch
}
{
assert_equal
[
r auth.changecount
]
0
# Auth again and validate change count
r auth.authrealuser auth-module-test
assert_equal
[
r auth.changecount
]
1
# Re-auth with the default user
r auth default
""
assert_equal
[
r auth.changecount
]
1
assert_equal
[
r acl whoami
]
"default"
# Re-auth with the default user again, to
# verify the callback isn't fired again
r auth default
""
assert_equal
[
r auth.changecount
]
0
assert_equal
[
r acl whoami
]
"default"
}
}
\ No newline at end of file
tests/unit/moduleapi/blockonkeys.tcl
0 → 100644
View file @
8341a7d4
set testmodule
[
file normalize tests/modules/blockonkeys.so
]
start_server
{
tags
{
"modules"
}}
{
r module load $testmodule
test
{
Module client blocked on keys
(
no metadata
)
: No block
}
{
r del k
r fsl.push k 33
r fsl.push k 34
r fsl.bpop2 k 0
}
{
34 33
}
test
{
Module client blocked on keys
(
no metadata
)
: Timeout
}
{
r del k
set rd
[
redis_deferring_client
]
r fsl.push k 33
$rd fsl.bpop2 k 1
assert_equal
{
Request timedout
}
[
$rd
read
]
}
test
{
Module client blocked on keys
(
no metadata
)
: Blocked, case 1
}
{
r del k
set rd
[
redis_deferring_client
]
r fsl.push k 33
$rd fsl.bpop2 k 0
r fsl.push k 34
assert_equal
{
34 33
}
[
$rd
read
]
}
test
{
Module client blocked on keys
(
no metadata
)
: Blocked, case 2
}
{
r del k
set rd
[
redis_deferring_client
]
r fsl.push k 33
r fsl.push k 34
$rd fsl.bpop2 k 0
assert_equal
{
34 33
}
[
$rd
read
]
}
test
{
Module client blocked on keys
(
with metadata
)
: No block
}
{
r del k
r fsl.push k 34
r fsl.bpopgt k 30 0
}
{
34
}
test
{
Module client blocked on keys
(
with metadata
)
: Timeout
}
{
r del k
set rd
[
redis_deferring_client
]
$rd client id
set cid
[
$rd
read
]
r fsl.push k 33
$rd fsl.bpopgt k 35 1
assert_equal
{
Request timedout
}
[
$rd
read
]
r client kill id $cid
;
# try to smoke-out client-related memory leak
}
test
{
Module client blocked on keys
(
with metadata
)
: Blocked, case 1
}
{
r del k
set rd
[
redis_deferring_client
]
$rd client id
set cid
[
$rd
read
]
r fsl.push k 33
$rd fsl.bpopgt k 33 0
r fsl.push k 34
assert_equal
{
34
}
[
$rd
read
]
r client kill id $cid
;
# try to smoke-out client-related memory leak
}
test
{
Module client blocked on keys
(
with metadata
)
: Blocked, case 2
}
{
r del k
set rd
[
redis_deferring_client
]
$rd fsl.bpopgt k 35 0
r fsl.push k 33
r fsl.push k 34
r fsl.push k 35
r fsl.push k 36
assert_equal
{
36
}
[
$rd
read
]
}
test
{
Module client blocked on keys
(
with metadata
)
: Blocked, CLIENT KILL
}
{
r del k
set rd
[
redis_deferring_client
]
$rd client id
set cid
[
$rd
read
]
$rd fsl.bpopgt k 35 0
r client kill id $cid
;
# try to smoke-out client-related memory leak
}
test
{
Module client blocked on keys
(
with metadata
)
: Blocked, CLIENT UNBLOCK TIMEOUT
}
{
r del k
set rd
[
redis_deferring_client
]
$rd client id
set cid
[
$rd
read
]
$rd fsl.bpopgt k 35 0
r client unblock $cid timeout
;
# try to smoke-out client-related memory leak
assert_equal
{
Request timedout
}
[
$rd
read
]
}
test
{
Module client blocked on keys
(
with metadata
)
: Blocked, CLIENT UNBLOCK ERROR
}
{
r del k
set rd
[
redis_deferring_client
]
$rd client id
set cid
[
$rd
read
]
$rd fsl.bpopgt k 35 0
r client unblock $cid error
;
# try to smoke-out client-related memory leak
assert_error
"*unblocked*"
{
$rd
read
}
}
test
{
Module client blocked on keys does not wake up on wrong type
}
{
r del k
set rd
[
redis_deferring_client
]
$rd fsl.bpop2 k 0
r lpush k 12
r lpush k 13
r lpush k 14
r del k
r fsl.push k 33
r fsl.push k 34
assert_equal
{
34 33
}
[
$rd
read
]
}
}
tests/unit/moduleapi/commandfilter.tcl
0 → 100644
View file @
8341a7d4
set testmodule
[
file normalize tests/modules/commandfilter.so
]
start_server
{
tags
{
"modules"
}}
{
r module load $testmodule log-key 0
test
{
Command Filter handles redirected commands
}
{
r set mykey @log
r lrange log-key 0 -1
}
"{set mykey @log}"
test
{
Command Filter can call RedisModule_CommandFilterArgDelete
}
{
r rpush mylist elem1 @delme elem2
r lrange mylist 0 -1
}
{
elem1 elem2
}
test
{
Command Filter can call RedisModule_CommandFilterArgInsert
}
{
r del mylist
r rpush mylist elem1 @insertbefore elem2 @insertafter elem3
r lrange mylist 0 -1
}
{
elem1 --inserted-before-- @insertbefore elem2 @insertafter --inserted-after-- elem3
}
test
{
Command Filter can call RedisModule_CommandFilterArgReplace
}
{
r del mylist
r rpush mylist elem1 @replaceme elem2
r lrange mylist 0 -1
}
{
elem1 --replaced-- elem2
}
test
{
Command Filter applies on RM_Call
()
commands
}
{
r del log-key
r commandfilter.ping
r lrange log-key 0 -1
}
"{ping @log}"
test
{
Command Filter applies on Lua redis.call
()}
{
r del log-key
r eval
"redis.call('ping', '@log')"
0
r lrange log-key 0 -1
}
"{ping @log}"
test
{
Command Filter applies on Lua redis.call
()
that calls a module
}
{
r del log-key
r eval
"redis.call('commandfilter.ping')"
0
r lrange log-key 0 -1
}
"{ping @log}"
test
{
Command Filter is unregistered implicitly on module unload
}
{
r del log-key
r module unload commandfilter
r set mykey @log
r lrange log-key 0 -1
}
{}
r module load $testmodule log-key 0
test
{
Command Filter unregister works as expected
}
{
# Validate reloading succeeded
r del log-key
r set mykey @log
assert_equal
"{set mykey @log}"
[
r lrange log-key 0 -1
]
# Unregister
r commandfilter.unregister
r del log-key
r set mykey @log
r lrange log-key 0 -1
}
{}
r module unload commandfilter
r module load $testmodule log-key 1
test
{
Command Filter REDISMODULE_CMDFILTER_NOSELF works as expected
}
{
r set mykey @log
assert_equal
"{set mykey @log}"
[
r lrange log-key 0 -1
]
r del log-key
r commandfilter.ping
assert_equal
{}
[
r lrange log-key 0 -1
]
r eval
"redis.call('commandfilter.ping')"
0
assert_equal
{}
[
r lrange log-key 0 -1
]
}
}
tests/unit/moduleapi/datatype.tcl
0 → 100644
View file @
8341a7d4
set testmodule
[
file normalize tests/modules/datatype.so
]
start_server
{
tags
{
"modules"
}}
{
r module load $testmodule
test
{
DataType: Test module is sane, GET/SET work.
}
{
r datatype.set dtkey 100 stringval
assert
{[
r datatype.get dtkey
]
eq
{
100 stringval
}}
}
test
{
DataType: RM_SaveDataTypeToString
()
, RM_LoadDataTypeFromString
()
work
}
{
r datatype.set dtkey -1111 MyString
set encoded
[
r datatype.dump dtkey
]
r datatype.restore dtkeycopy $encoded
assert
{[
r datatype.get dtkeycopy
]
eq
{
-1111 MyString
}}
}
test
{
DataType: Handle truncated RM_LoadDataTypeFromString
()}
{
r datatype.set dtkey -1111 MyString
set encoded
[
r datatype.dump dtkey
]
set truncated
[
string range $encoded 0 end-1
]
catch
{
r datatype.restore dtkeycopy $truncated
}
e
set e
}
{
*Invalid*
}
test
{
DataType: ModuleTypeReplaceValue
()
happy path works
}
{
r datatype.set key-a 1 AAA
r datatype.set key-b 2 BBB
assert
{[
r datatype.swap key-a key-b
]
eq
{
OK
}}
assert
{[
r datatype.get key-a
]
eq
{
2 BBB
}}
assert
{[
r datatype.get key-b
]
eq
{
1 AAA
}}
}
test
{
DataType: ModuleTypeReplaceValue
()
fails on non-module keys
}
{
r datatype.set key-a 1 AAA
r set key-b RedisString
catch
{
r datatype.swap key-a key-b
}
e
set e
}
{
*ERR*
}
}
tests/unit/moduleapi/fork.tcl
0 → 100644
View file @
8341a7d4
set testmodule
[
file normalize tests/modules/fork.so
]
proc count_log_message
{
pattern
}
{
set result
[
exec grep -c $pattern <
[
srv 0 stdout
]]
}
start_server
{
tags
{
"modules"
}}
{
r module load $testmodule
test
{
Module fork
}
{
# the argument to fork.create is the exitcode on termination
r fork.create 3
wait_for_condition 20 100
{
[
r fork.exitcode
]
!= -1
}
else
{
fail
"fork didn't terminate"
}
r fork.exitcode
}
{
3
}
test
{
Module fork kill
}
{
r fork.create 3
after 20
r fork.kill
after 100
assert
{[
count_log_message
"fork child started"
]
eq
"2"
}
assert
{[
count_log_message
"Received SIGUSR1 in child"
]
eq
"1"
}
assert
{[
count_log_message
"fork child exiting"
]
eq
"1"
}
}
}
Prev
1
…
5
6
7
8
9
10
11
Next
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