github/redis
1
1
Fork 0
mirror of https://github.com/redis/redis.git synced 2026-04-21 03:01:35 -04:00
Code Issues Packages Projects Releases Wiki Activity

new test engine backported to 2.4

Browse Source
This commit is contained in:
antirez
2011-07-12 09:40:54 +02:00
parent 0462d983c2
commit 619174117d
16 changed files with 638 additions and 418 deletions
Download Patch File Download Diff File Expand all files Collapse all files

182
tests/assets/default.conf
View File

@@ -18,9 +18,9 @@ daemonize no
# When running daemonized, Redis writes a pid file in /var/run/redis.pid by
# default. You can specify a custom pid file location here.
pidfile redis.pid
pidfile /var/run/redis.pid
# Accept connections on the specified port, default is 6379
# Accept connections on the specified port, default is 6379.
port 6379
# If you want you can bind a single interface, if the bind option is not
@@ -28,6 +28,12 @@ port 6379
#
# bind 127.0.0.1
# Specify the path for the unix socket that will be used to listen for
# incoming connections. There is no default, so Redis will not listen
# on a unix socket when not specified.
#
# unixsocket /tmp/redis.sock
# Close the connection after a client is idle for N seconds (0 to disable)
timeout 300
@@ -44,6 +50,16 @@ loglevel verbose
# output for logging but daemonize, logs will be sent to /dev/null
logfile stdout
# To enable logging to the system logger, just set 'syslog-enabled' to yes,
# and optionally update the other syslog parameters to suit your needs.
# syslog-enabled no
# Specify the syslog identity.
# syslog-ident redis
# Specify the syslog facility. Must be USER or between LOCAL0-LOCAL7.
# syslog-facility local0
# Set the number of databases. The default database is DB 0, you can select
# a different one on a per-connection basis using SELECT <dbid> where
# dbid is a number between 0 and 'databases'-1
@@ -86,7 +102,7 @@ dbfilename dump.rdb
# Also the Append Only File will be created inside this directory.
#
# Note that you must specify a directory here, not a file name.
dir ./test/tmp
dir ./
################################# REPLICATION #################################
@@ -104,6 +120,19 @@ dir ./test/tmp
#
# masterauth <master-password>
# When a slave lost the connection with the master, or when the replication
# is still in progress, the slave can act in two different ways:
#
# 1) if slave-serve-stale-data is set to 'yes' (the default) the slave will
# still reply to client requests, possibly with out of data data, or the
# data set may just be empty if this is the first synchronization.
#
# 2) if slave-serve-stale data is set to 'no' the slave will reply with
# an error "SYNC with master in progress" to all the kind of commands
# but to INFO and SLAVEOF.
#
slave-serve-stale-data yes
################################## SECURITY ###################################
# Require clients to issue AUTH <PASSWORD> before processing any other
@@ -119,6 +148,22 @@ dir ./test/tmp
#
# requirepass foobared
# Command renaming.
#
# It is possilbe to change the name of dangerous commands in a shared
# environment. For instance the CONFIG command may be renamed into something
# of hard to guess so that it will be still available for internal-use
# tools but not available for general clients.
#
# Example:
#
# rename-command CONFIG b840fc02d524045429941cc15f59e41cb7be6c52
#
# It is also possilbe to completely kill a command renaming it into
# an empty string:
#
# rename-command CONFIG ""
################################### LIMITS ####################################
# Set the max number of connected clients at the same time. By default there
@@ -148,6 +193,37 @@ dir ./test/tmp
#
# maxmemory <bytes>
# MAXMEMORY POLICY: how Redis will select what to remove when maxmemory
# is reached? You can select among five behavior:
#
# volatile-lru -> remove the key with an expire set using an LRU algorithm
# allkeys-lru -> remove any key accordingly to the LRU algorithm
# volatile-random -> remove a random key with an expire set
# allkeys->random -> remove a random key, any key
# volatile-ttl -> remove the key with the nearest expire time (minor TTL)
# noeviction -> don't expire at all, just return an error on write operations
#
# Note: with all the kind of policies, Redis will return an error on write
# operations, when there are not suitable keys for eviction.
#
# At the date of writing this commands are: set setnx setex append
# incr decr rpush lpush rpushx lpushx linsert lset rpoplpush sadd
# sinter sinterstore sunion sunionstore sdiff sdiffstore zadd zincrby
# zunionstore zinterstore hset hsetnx hmset hincrby incrby decrby
# getset mset msetnx exec sort
#
# The default is:
#
# maxmemory-policy volatile-lru
# LRU and minimal TTL algorithms are not precise algorithms but approximated
# algorithms (in order to save memory), so you can select as well the sample
# size to check. For instance for default Redis will check three keys and
# pick the one that was used less recently, you can change the sample size
# using the following configuration directive.
#
# maxmemory-samples 3
############################## APPEND ONLY MODE ###############################
# By default Redis asynchronously dumps the dataset on disk. If you can live
@@ -195,81 +271,28 @@ appendonly no
appendfsync everysec
# appendfsync no
################################ VIRTUAL MEMORY ###############################
# Virtual Memory allows Redis to work with datasets bigger than the actual
# amount of RAM needed to hold the whole dataset in memory.
# In order to do so very used keys are taken in memory while the other keys
# are swapped into a swap file, similarly to what operating systems do
# with memory pages.
# When the AOF fsync policy is set to always or everysec, and a background
# saving process (a background save or AOF log background rewriting) is
# performing a lot of I/O against the disk, in some Linux configurations
# Redis may block too long on the fsync() call. Note that there is no fix for
# this currently, as even performing fsync in a different thread will block
# our synchronous write(2) call.
#
# To enable VM just set 'vm-enabled' to yes, and set the following three
# VM parameters accordingly to your needs.
vm-enabled no
# vm-enabled yes
# This is the path of the Redis swap file. As you can guess, swap files
# can't be shared by different Redis instances, so make sure to use a swap
# file for every redis process you are running. Redis will complain if the
# swap file is already in use.
# In order to mitigate this problem it's possible to use the following option
# that will prevent fsync() from being called in the main process while a
# BGSAVE or BGREWRITEAOF is in progress.
#
# The best kind of storage for the Redis swap file (that's accessed at random)
# is a Solid State Disk (SSD).
#
# *** WARNING *** if you are using a shared hosting the default of putting
# the swap file under /tmp is not secure. Create a dir with access granted
# only to Redis user and configure Redis to create the swap file there.
vm-swap-file redis.swap
# vm-max-memory configures the VM to use at max the specified amount of
# RAM. Everything that deos not fit will be swapped on disk *if* possible, that
# is, if there is still enough contiguous space in the swap file.
#
# With vm-max-memory 0 the system will swap everything it can. Not a good
# default, just specify the max amount of RAM you can in bytes, but it's
# better to leave some margin. For instance specify an amount of RAM
# that's more or less between 60 and 80% of your free RAM.
vm-max-memory 0
# Redis swap files is split into pages. An object can be saved using multiple
# contiguous pages, but pages can't be shared between different objects.
# So if your page is too big, small objects swapped out on disk will waste
# a lot of space. If you page is too small, there is less space in the swap
# file (assuming you configured the same number of total swap file pages).
#
# If you use a lot of small objects, use a page size of 64 or 32 bytes.
# If you use a lot of big objects, use a bigger page size.
# If unsure, use the default :)
vm-page-size 32
# Number of total memory pages in the swap file.
# Given that the page table (a bitmap of free/used pages) is taken in memory,
# every 8 pages on disk will consume 1 byte of RAM.
#
# The total swap size is vm-page-size * vm-pages
#
# 32M swap should be enough for testing.
vm-pages 1048576
# Max number of VM I/O threads running at the same time.
# This threads are used to read/write data from/to swap file, since they
# also encode and decode objects from disk to memory or the reverse, a bigger
# number of threads can help with big objects even if they can't help with
# I/O itself as the physical device may not be able to couple with many
# reads/writes operations at the same time.
#
# The special value of 0 turn off threaded I/O and enables the blocking
# Virtual Memory implementation.
vm-max-threads 4
# This means that while another child is saving the durability of Redis is
# the same as "appendfsync none", that in pratical terms means that it is
# possible to lost up to 30 seconds of log in the worst scenario (with the
# default Linux settings).
#
# If you have latency problems turn this to "yes". Otherwise leave it as
# "no" that is the safest pick from the point of view of durability.
no-appendfsync-on-rewrite no
############################### ADVANCED CONFIG ###############################
# Glue small output buffers together in order to send small replies in a
# single TCP packet. Uses a bit more CPU but most of the times it is a win
# in terms of number of queries per second. Use 'yes' if unsure.
glueoutputbuf yes
# Hashes are encoded in a special way (much more memory efficient) when they
# have at max a given numer of elements, and the biggest element does not
# exceed a given threshold. You can configure this limits with the following
@@ -277,6 +300,19 @@ glueoutputbuf yes
hash-max-zipmap-entries 64
hash-max-zipmap-value 512
# Similarly to hashes, small lists are also encoded in a special way in order
# to save a lot of space. The special representation is only used when
# you are under the following limits:
list-max-ziplist-entries 512
list-max-ziplist-value 64
# Sets have a special encoding in just one case: when a set is composed
# of just strings that happens to be integers in radix 10 in the range
# of 64 bit signed integers.
# The following configuration setting sets the limit in the size of the
# set in order to use this special memory saving encoding.
set-max-intset-entries 512
# Active rehashing uses 1 millisecond every 100 milliseconds of CPU time in
# order to help rehashing the main Redis hash table (the one mapping top-level
# keys to values). The hash table implementation redis uses (see dict.c)

27
tests/integration/aof.tcl
View File

@@ -32,6 +32,7 @@ tags {"aof"} {
start_server_aof [list dir $server_path] {
test "Unfinished MULTI: Server should not have been started" {
if {$::valgrind} {after 2000}
assert_equal 0 [is_alive $srv]
}
@@ -49,6 +50,7 @@ tags {"aof"} {
start_server_aof [list dir $server_path] {
test "Short read: Server should not have been started" {
if {$::valgrind} {after 2000}
assert_equal 0 [is_alive $srv]
}
@@ -101,4 +103,29 @@ tags {"aof"} {
assert_equal 1 [$client scard set]
}
}
## Test that EXPIREAT is loaded correctly
create_aof {
append_to_aof [formatCommand rpush list foo]
append_to_aof [formatCommand expireat list 1000]
append_to_aof [formatCommand rpush list bar]
}
start_server_aof [list dir $server_path] {
test "AOF+EXPIRE: Server should have been started" {
assert_equal 1 [is_alive $srv]
}
test "AOF+EXPIRE: List should be empty" {
set client [redis [dict get $srv host] [dict get $srv port]]
assert_equal 0 [$client llen list]
}
}
start_server {overrides {appendonly {yes} appendfilename {appendonly.aof}}} {
test {Redis should not try to convert DEL into EXPIREAT for EXPIRE -1} {
r set x 10
r expire x -1
}
}
}

27
tests/integration/replication-2.tcl Normal file
View File

@@ -0,0 +1,27 @@
start_server {tags {"repl"}} {
start_server {} {
test {First server should have role slave after SLAVEOF} {
r -1 slaveof [srv 0 host] [srv 0 port]
after 1000
s -1 role
} {slave}
test {MASTER and SLAVE dataset should be identical after complex ops} {
createComplexDataset r 10000
after 500
if {[r debug digest] ne [r -1 debug digest]} {
set csv1 [csvdump r]
set csv2 [csvdump {r -1}]
set fd [open /tmp/repldump1.txt w]
puts -nonewline $fd $csv1
close $fd
set fd [open /tmp/repldump2.txt w]
puts -nonewline $fd $csv2
close $fd
puts "Master - Slave inconsistency"
puts "Run diff -u against /tmp/repldump*.txt for more info"
}
assert_equal [r debug digest] [r -1 debug digest]
}
}
}

31
tests/integration/replication-3.tcl Normal file
View File

@@ -0,0 +1,31 @@
start_server {tags {"repl"}} {
start_server {} {
test {First server should have role slave after SLAVEOF} {
r -1 slaveof [srv 0 host] [srv 0 port]
after 1000
s -1 role
} {slave}
if {$::accurate} {set numops 50000} else {set numops 5000}
test {MASTER and SLAVE consistency with expire} {
createComplexDataset r $numops useexpire
after 4000 ;# Make sure everything expired before taking the digest
r keys * ;# Force DEL syntesizing to slave
after 1000 ;# Wait another second. Now everything should be fine.
if {[r debug digest] ne [r -1 debug digest]} {
set csv1 [csvdump r]
set csv2 [csvdump {r -1}]
set fd [open /tmp/repldump1.txt w]
puts -nonewline $fd $csv1
close $fd
set fd [open /tmp/repldump2.txt w]
puts -nonewline $fd $csv2
close $fd
puts "Master - Slave inconsistency"
puts "Run diff -u against /tmp/repldump*.txt for more info"
}
assert_equal [r debug digest] [r -1 debug digest]
}
}
}

39
tests/integration/replication.tcl
View File

@@ -23,44 +23,6 @@ start_server {tags {"repl"}} {
after 1000
assert_equal [r debug digest] [r -1 debug digest]
}
test {MASTER and SLAVE dataset should be identical after complex ops} {
createComplexDataset r 10000
after 500
if {[r debug digest] ne [r -1 debug digest]} {
set csv1 [csvdump r]
set csv2 [csvdump {r -1}]
set fd [open /tmp/repldump1.txt w]
puts -nonewline $fd $csv1
close $fd
set fd [open /tmp/repldump2.txt w]
puts -nonewline $fd $csv2
close $fd
puts "Master - Slave inconsistency"
puts "Run diff -u against /tmp/repldump*.txt for more info"
}
assert_equal [r debug digest] [r -1 debug digest]
}
test {MASTER and SLAVE consistency with expire} {
createComplexDataset r 50000 useexpire
after 4000 ;# Make sure everything expired before taking the digest
r keys * ;# Force DEL syntesizing to slave
after 1000 ;# Wait another second. Now everything should be fine.
if {[r debug digest] ne [r -1 debug digest]} {
set csv1 [csvdump r]
set csv2 [csvdump {r -1}]
set fd [open /tmp/repldump1.txt w]
puts -nonewline $fd $csv1
close $fd
set fd [open /tmp/repldump2.txt w]
puts -nonewline $fd $csv2
close $fd
puts "Master - Slave inconsistency"
puts "Run diff -u against /tmp/repldump*.txt for more info"
}
assert_equal [r debug digest] [r -1 debug digest]
}
}
}
@@ -92,6 +54,7 @@ start_server {tags {"repl"}} {
test {SET on the master should immediately propagate} {
r -1 set mykey bar
if {$::valgrind} {after 2000}
r 0 get mykey
} {bar}
}

13
tests/support/server.tcl
View File

@@ -1,5 +1,6 @@
set ::global_overrides {}
set ::tags {}
set ::valgrind_errors {}
proc error_and_quit {config_file error} {
puts "!!COULD NOT START REDIS-SERVER\n"
@@ -16,11 +17,9 @@ proc check_valgrind_errors stderr {
close $fd
if {![regexp -- {ERROR SUMMARY: 0 errors} $buf] ||
![regexp -- {definitely lost: 0 bytes} $buf]} {
puts "*** VALGRIND ERRORS ***"
puts $buf
puts "--- press enter to continue ---"
gets stdin
(![regexp -- {definitely lost: 0 bytes} $buf] &&
![regexp -- {no leaks are possible} $buf])} {
send_data_packet $::test_server_fd err "Valgrind error: $buf\n"
}
}
@@ -182,7 +181,7 @@ proc start_server {options {code undefined}} {
# check that the server actually started
# ugly but tries to be as fast as possible...
set retrynum 20
set retrynum 100
set serverisup 0
if {$::verbose} {
@@ -214,7 +213,7 @@ proc start_server {options {code undefined}} {
# find out the pid
while {![info exists pid]} {
regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid
regexp {\[(\d+)\]} [exec cat $stdout] _ pid
after 100
}

99
tests/support/test.tcl
View File

@@ -49,57 +49,28 @@ proc color_term {} {
expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
}
# This is called before starting the test
proc announce_test {s} {
proc colorstr {color str} {
if {[color_term]} {
puts -nonewline "$s\033\[0K"
flush stdout
set ::backward_count [string length $s]
}
}
# This is called after the test finished
proc colored_dot {tags passed} {
if {[color_term]} {
# Go backward and delete what announc_test function printed.
puts -nonewline "\033\[${::backward_count}D\033\[0K\033\[J"
# Print a coloured char, accordingly to test outcome and tags.
if {[lsearch $tags list] != -1} {
set colorcode {31}
set ch L
} elseif {[lsearch $tags hash] != -1} {
set colorcode {32}
set ch H
} elseif {[lsearch $tags set] != -1} {
set colorcode {33}
set ch S
} elseif {[lsearch $tags zset] != -1} {
set colorcode {34}
set ch Z
} elseif {[lsearch $tags basic] != -1} {
set colorcode {35}
set ch B
} else {
set colorcode {37}
set ch .
set b 0
if {[string range $color 0 4] eq {bold-}} {
set b 1
set color [string range $color 5 end]
}
switch $color {
red {set colorcode {31}}
green {set colorcode {32}}
yellow {set colorcode {33}}
blue {set colorcode {34}}
magenta {set colorcode {35}}
cyan {set colorcode {36}}
white {set colorcode {37}}
default {set colorcode {37}}
}
if {$colorcode ne {}} {
if {$passed} {
puts -nonewline "\033\[0;${colorcode};40m"
} else {
puts -nonewline "\033\[7;${colorcode};40m"
}
puts -nonewline $ch
puts -nonewline "\033\[0m"
flush stdout
return "\033\[$b;${colorcode};40m$str\033\[0m"
}
} else {
if {$passed} {
puts -nonewline .
} else {
puts -nonewline F
}
return $str
}
}
@@ -127,16 +98,9 @@ proc test {name code {okpattern undefined}} {
incr ::num_tests
set details {}
lappend details $::curfile
lappend details $::tags
lappend details $name
lappend details "$name in $::curfile"
if {$::verbose} {
puts -nonewline [format "#%03d %-68s " $::num_tests $name]
flush stdout
} else {
announce_test $name
}
send_data_packet $::test_server_fd testing $name
if {[catch {set retval [uplevel 1 $code]} error]} {
if {[string match "assertion:*" $error]} {
@@ -145,12 +109,7 @@ proc test {name code {okpattern undefined}} {
lappend ::tests_failed $details
incr ::num_failed
if {$::verbose} {
puts "FAILED"
puts "$msg\n"
} else {
colored_dot $::tags 0
}
send_data_packet $::test_server_fd err [join $details "\n"]
} else {
# Re-raise, let handler up the stack take care of this.
error $error $::errorInfo
@@ -158,33 +117,21 @@ proc test {name code {okpattern undefined}} {
} else {
if {$okpattern eq "undefined" || $okpattern eq $retval || [string match $okpattern $retval]} {
incr ::num_passed
if {$::verbose} {
puts "PASSED"
} else {
colored_dot $::tags 1
}
send_data_packet $::test_server_fd ok $name
} else {
set msg "Expected '$okpattern' to equal or match '$retval'"
lappend details $msg
lappend ::tests_failed $details
incr ::num_failed
if {$::verbose} {
puts "FAILED"
puts "$msg\n"
} else {
colored_dot $::tags 0
}
send_data_packet $::test_server_fd err [join $details "\n"]
}
}
flush stdout
if {$::traceleaks} {
set output [exec leaks redis-server]
if {![string match {*0 leaks*} $output]} {
puts "--- Test \"$name\" leaked! ---"
puts $output
exit 1
send_data_packet $::test_server_fd err "Detected a memory leak in test '$name': $output"
}
}
}

330
tests/test_helper.tcl
View File

@@ -9,6 +9,32 @@ source tests/support/tmpfile.tcl
source tests/support/test.tcl
source tests/support/util.tcl
set ::all_tests {
unit/printver
unit/auth
unit/protocol
unit/basic
unit/type/list
unit/type/list-2
unit/type/list-3
unit/type/set
unit/type/zset
unit/type/hash
unit/sort
unit/expire
unit/other
unit/cas
unit/quit
integration/replication
integration/replication-2
integration/replication-3
integration/aof
unit/pubsub
unit/slowlog
}
# Index to the next test to run in the ::all_tests list.
set ::next_test 0
set ::host 127.0.0.1
set ::port 16379
set ::traceleaks 0
@@ -19,11 +45,22 @@ set ::allowtags {}
set ::external 0; # If "1" this means, we are running against external instance
set ::file ""; # If set, runs only the tests in this comma separated list
set ::curfile ""; # Hold the filename of the current suite
set ::accurate 0; # If true runs fuzz tests with more iterations
set ::force_failure 0
# 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
# runs the specified number of client instances that will actually run tests.
# The server is responsible of showing the result to the user, and exit with
# the appropriate exit code depending on the test outcome.
set ::client 0
set ::numclients 16
proc execute_tests name {
set path "tests/$name.tcl"
set ::curfile $path
source $path
send_data_packet $::test_server_fd done "$name"
}
# Setup a list to hold a stack of server configs. When calls to start_server
@@ -103,88 +140,189 @@ proc s {args} {
}
proc cleanup {} {
puts -nonewline "Cleanup: may take some time... "
flush stdout
catch {exec rm -rf {*}[glob tests/tmp/redis.conf.*]}
catch {exec rm -rf {*}[glob tests/tmp/server.*]}
puts "OK"
}
proc execute_everything {} {
if 0 {
# Use this when hacking on new tests.
set ::verbose 1
execute_tests "unit/first"
return
}
execute_tests "unit/printver"
execute_tests "unit/auth"
execute_tests "unit/protocol"
execute_tests "unit/basic"
execute_tests "unit/type/list"
execute_tests "unit/type/set"
execute_tests "unit/type/zset"
execute_tests "unit/type/hash"
execute_tests "unit/sort"
execute_tests "unit/expire"
execute_tests "unit/other"
execute_tests "unit/cas"
execute_tests "unit/quit"
execute_tests "integration/replication"
execute_tests "integration/aof"
# execute_tests "integration/redis-cli"
execute_tests "unit/pubsub"
execute_tests "unit/slowlog"
# run tests with VM enabled
if 0 {
set ::global_overrides {vm-enabled yes}
execute_tests "unit/protocol"
execute_tests "unit/basic"
execute_tests "unit/type/list"
execute_tests "unit/type/set"
execute_tests "unit/type/zset"
execute_tests "unit/type/hash"
execute_tests "unit/sort"
execute_tests "unit/expire"
execute_tests "unit/other"
execute_tests "unit/cas"
}
}
proc main {} {
proc test_server_main {} {
cleanup
if {[string length $::file] > 0} {
foreach {file} [split $::file ,] {
execute_tests $file
}
} else {
execute_everything
}
cleanup
puts "\n[expr $::num_tests] tests, $::num_passed passed, $::num_failed failed\n"
if {$::num_failed > 0} {
set curheader ""
puts "Failures:"
foreach {test} $::tests_failed {
set header [lindex $test 0]
append header " ("
append header [join [lindex $test 1] ","]
append header ")"
if {$curheader ne $header} {
set curheader $header
puts "\n$curheader:"
# Open a listening socket, trying different ports in order to find a
# non busy one.
set port 11111
while 1 {
puts "Starting test server at port $port"
if {[catch {socket -server accept_test_clients $port} e]} {
if {[string match {*address already in use*} $e]} {
if {$port == 20000} {
puts "Can't find an available TCP port for test server."
exit 1
} else {
incr port
}
} else {
puts "Fatal error starting test server: $e"
exit 1
}
set name [lindex $test 2]
set msg [lindex $test 3]
puts "- $name: $msg"
} else {
break
}
puts ""
exit 1
}
# Start the client instances
set ::clients_pids {}
for {set j 0} {$j < $::numclients} {incr j} {
set p [exec tclsh8.5 [info script] {*}$::argv \
--client $port --port [expr {$::port+($j*10)}] &]
lappend ::clients_pids $p
}
# Setup global state for the test server
set ::idle_clients {}
set ::active_clients {}
array set ::clients_start_time {}
set ::clients_time_history {}
set ::failed_tests {}
# Enter the event loop to handle clients I/O
after 100 test_server_cron
vwait forever
}
# This function gets called 10 times per second, for now does nothing but
# may be used in the future in order to detect test clients taking too much
# time to execute the task.
proc test_server_cron {} {
}
proc accept_test_clients {fd addr port} {
fileevent $fd readable [list read_from_test_client $fd]
}
# This is the readable handler of our test server. Clients send us messages
# in the form of a status code such and additional data. Supported
# status types are:
#
# ready: the client is ready to execute the command. Only sent at client
# startup. The server will queue the client FD in the list of idle
# clients.
# testing: just used to signal that a given test started.
# ok: a test was executed with success.
# err: a test was executed with an error.
# exception: there was a runtime exception while executing the test.
# done: all the specified test file was processed, this test client is
# ready to accept a new task.
proc read_from_test_client fd {
set bytes [gets $fd]
set payload [read $fd $bytes]
foreach {status data} $payload break
if {$status eq {ready}} {
puts "\[$status\]: $data"
signal_idle_client $fd
} elseif {$status eq {done}} {
set elapsed [expr {[clock seconds]-$::clients_start_time($fd)}]
puts "\[[colorstr yellow $status]\]: $data ($elapsed seconds)"
puts "+++ [expr {[llength $::active_clients]-1}] units still in execution."
lappend ::clients_time_history $elapsed $data
signal_idle_client $fd
} elseif {$status eq {ok}} {
puts "\[[colorstr green $status]\]: $data"
} elseif {$status eq {err}} {
set err "\[[colorstr red $status]\]: $data"
puts $err
lappend ::failed_tests $err
} elseif {$status eq {exception}} {
puts "\[[colorstr red $status]\]: $data"
foreach p $::clients_pids {
catch {exec kill -9 $p}
}
exit 1
} elseif {$status eq {testing}} {
# No op
} else {
puts "\[$status\]: $data"
}
}
# A new client is idle. Remove it from the list of active clients and
# if there are still test units to run, launch them.
proc signal_idle_client fd {
# Remove this fd from the list of active clients.
set ::active_clients \
[lsearch -all -inline -not -exact $::active_clients $fd]
# New unit to process?
if {$::next_test != [llength $::all_tests]} {
puts [colorstr bold-white "Testing [lindex $::all_tests $::next_test]"]
set ::clients_start_time($fd) [clock seconds]
send_data_packet $fd run [lindex $::all_tests $::next_test]
lappend ::active_clients $fd
incr ::next_test
} else {
lappend ::idle_clients $fd
if {[llength $::active_clients] == 0} {
the_end
}
}
}
# The the_end funciton gets called when all the test units were already
# executed, so the test finished.
proc the_end {} {
# TODO: print the status, exit with the rigth exit code.
puts "\n The End\n"
puts "Execution time of different units:"
foreach {time name} $::clients_time_history {
puts " $time seconds - $name"
}
if {[llength $::failed_tests]} {
puts "\n[colorstr bold-red {!!! WARNING}] The following tests failed:\n"
foreach failed $::failed_tests {
puts "*** $failed"
}
cleanup
exit 1
} else {
puts "\n[colorstr bold-white {\o/}] [colorstr bold-green {All tests passed without errors!}]\n"
cleanup
exit 0
}
}
# The client is not even driven (the test server is instead) as we just need
# to read the command, execute, reply... all this in a loop.
proc test_client_main server_port {
set ::test_server_fd [socket localhost $server_port]
send_data_packet $::test_server_fd ready [pid]
while 1 {
set bytes [gets $::test_server_fd]
set payload [read $::test_server_fd $bytes]
foreach {cmd data} $payload break
if {$cmd eq {run}} {
execute_tests $data
} else {
error "Unknown test client command: $cmd"
}
}
}
proc send_data_packet {fd status data} {
set payload [list $status $data]
puts $fd [string length $payload]
puts -nonewline $fd $payload
flush $fd
}
proc print_help_screen {} {
puts [join {
"--valgrind Run the test over valgrind."
"--accurate Run slow randomized tests for more iterations."
"--single <unit> Just execute the specified unit (see next option)."
"--list-tests List all the available test units."
"--force-failure Force the execution of a test that always fails."
"--help Print this help screen."
} "\n"]
}
# parse arguments
@@ -202,9 +340,6 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
incr j
} elseif {$opt eq {--valgrind}} {
set ::valgrind 1
} elseif {$opt eq {--file}} {
set ::file $arg
incr j
} elseif {$opt eq {--host}} {
set ::external 1
set ::host $arg
@@ -212,20 +347,47 @@ for {set j 0} {$j < [llength $argv]} {incr j} {
} elseif {$opt eq {--port}} {
set ::port $arg
incr j
} elseif {$opt eq {--verbose}} {
set ::verbose 1
} elseif {$opt eq {--accurate}} {
set ::accurate 1
} elseif {$opt eq {--force-failure}} {
set ::force_failure 1
} elseif {$opt eq {--single}} {
set ::all_tests $arg
incr j
} elseif {$opt eq {--list-tests}} {
foreach t $::all_tests {
puts $t
}
exit 0
} elseif {$opt eq {--client}} {
set ::client 1
set ::test_server_port $arg
incr j
} elseif {$opt eq {--help}} {
print_help_screen
exit 0
} 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 $::errorInfo
if {$::client} {
if {[catch { test_client_main $::test_server_port } err]} {
set estr "Executing test client: $err.\n$::errorInfo"
if {[catch {send_data_packet $::test_server_fd exception $estr}]} {
puts $estr
}
exit 1
}
} else {
if {[catch { test_server_main } err]} {
if {[string length $err] > 0} {
# only display error when not generated by the test suite
if {$err ne "exception"} {
puts $::errorInfo
}
exit 1
}
}
}

2
tests/unit/expire.tcl
View File

@@ -7,7 +7,7 @@ start_server {tags {"expire"}} {
set v4 [r ttl x]
r expire x 4
list $v1 $v2 $v3 $v4
} {1 5 1 10}
} {1 [45] 1 10}
test {EXPIRE - It should be still possible to read 'x'} {
r get x

71
tests/unit/other.tcl
View File

@@ -1,4 +1,11 @@
start_server {tags {"other"}} {
if {$::force_failure} {
# This is used just for test suite development purposes.
test {Failing test} {
format err
} {ok}
}
test {SAVE - make sure there are all the types as values} {
# Wait for a background saving in progress to terminate
waitForBgsave r
@@ -12,11 +19,12 @@ start_server {tags {"other"}} {
r save
} {OK}
tags {"slow"} {
tags {slow} {
if {$::accurate} {set iterations 10000} else {set iterations 1000}
foreach fuzztype {binary alpha compr} {
test "FUZZ stresser with data model $fuzztype" {
set err 0
for {set i 0} {$i < 10000} {incr i} {
for {set i 0} {$i < $iterations} {incr i} {
set fuzz [randstring 0 512 $fuzztype]
r set foo $fuzz
set got [r get foo]
@@ -48,9 +56,10 @@ start_server {tags {"other"}} {
tags {consistency} {
if {![catch {package require sha1}]} {
if {$::accurate} {set numops 10000} else {set numops 1000}
test {Check consistency of different data types after a reload} {
r flushdb
createComplexDataset r 10000
createComplexDataset r $numops
set dump [csvdump r]
set sha1 [r debug digest]
r debug reload
@@ -108,39 +117,42 @@ start_server {tags {"other"}} {
set e1 [expr {$ttl > 900 && $ttl <= 1000}]
r bgrewriteaof
waitForBgrewriteaof r
r debug loadaof
set ttl [r ttl x]
set e2 [expr {$ttl > 900 && $ttl <= 1000}]
list $e1 $e2
} {1 1}
test {PIPELINING stresser (also a regression for the old epoll bug)} {
set fd2 [socket $::host $::port]
fconfigure $fd2 -encoding binary -translation binary
puts -nonewline $fd2 "SELECT 9\r\n"
flush $fd2
gets $fd2
tags {protocol} {
test {PIPELINING stresser (also a regression for the old epoll bug)} {
set fd2 [socket $::host $::port]
fconfigure $fd2 -encoding binary -translation binary
puts -nonewline $fd2 "SELECT 9\r\n"
flush $fd2
gets $fd2
for {set i 0} {$i < 100000} {incr i} {
set q {}
set val "0000${i}0000"
append q "SET key:$i $val\r\n"
puts -nonewline $fd2 $q
set q {}
append q "GET key:$i\r\n"
puts -nonewline $fd2 $q
}
flush $fd2
for {set i 0} {$i < 100000} {incr i} {
set q {}
set val "0000${i}0000"
append q "SET key:$i $val\r\n"
puts -nonewline $fd2 $q
set q {}
append q "GET key:$i\r\n"
puts -nonewline $fd2 $q
}
flush $fd2
for {set i 0} {$i < 100000} {incr i} {
gets $fd2 line
gets $fd2 count
set count [string range $count 1 end]
set val [read $fd2 $count]
read $fd2 2
}
close $fd2
set _ 1
} {1}
for {set i 0} {$i < 100000} {incr i} {
gets $fd2 line
gets $fd2 count
set count [string range $count 1 end]
set val [read $fd2 $count]
read $fd2 2
}
close $fd2
set _ 1
} {1}
}
test {MUTLI / EXEC basics} {
r del mylist
@@ -235,6 +247,7 @@ start_server {tags {"other"}} {
} {0 0}
test {Perform a final SAVE to leave a clean DB on disk} {
waitForBgsave r
r save
} {OK}
}

2
tests/unit/slowlog.tcl
View File

@@ -1,4 +1,4 @@
start_server {tags {"slowlog"}} {
start_server {tags {"slowlog"} overrides {slowlog-log-slower-than 1000000}} {
test {SLOWLOG - check that it starts with an empty log} {
r slowlog len
} {0}

44
tests/unit/type/list-2.tcl Normal file
View File

@@ -0,0 +1,44 @@
start_server {
tags {"list"}
overrides {
"list-max-ziplist-value" 16
"list-max-ziplist-entries" 256
}
} {
source "tests/unit/type/list-common.tcl"
foreach {type large} [array get largevalue] {
tags {"slow"} {
test "LTRIM stress testing - $type" {
set mylist {}
set startlen 32
r del mylist
# Start with the large value to ensure the
# right encoding is used.
r rpush mylist $large
lappend mylist $large
for {set i 0} {$i < $startlen} {incr i} {
set str [randomInt 9223372036854775807]
r rpush mylist $str
lappend mylist $str
}
for {set i 0} {$i < 1000} {incr i} {
set min [expr {int(rand()*$startlen)}]
set max [expr {$min+int(rand()*$startlen)}]
set mylist [lrange $mylist $min $max]
r ltrim mylist $min $max
assert_equal $mylist [r lrange mylist 0 -1]
for {set j [r llen mylist]} {$j < $startlen} {incr j} {
set str [randomInt 9223372036854775807]
r rpush mylist $str
lappend mylist $str
}
}
}
}
}
}

70
tests/unit/type/list-3.tcl Normal file
View File

@@ -0,0 +1,70 @@
start_server {
tags {list ziplist}
overrides {
"list-max-ziplist-value" 200000
"list-max-ziplist-entries" 256
}
} {
test {Explicit regression for a list bug} {
set mylist {49376042582 {BkG2o\pIC]4YYJa9cJ4GWZalG[4tin;1D2whSkCOW`mX;SFXGyS8sedcff3fQI^tgPCC@^Nu1J6o]meM@Lko]t_jRyo<xSJ1oObDYd`ppZuW6P@fS278YaOx=s6lvdFlMbP0[SbkI^Kr\HBXtuFaA^mDx:yzS4a[skiiPWhT<nNfAf=aQVfclcuwDrfe;iVuKdNvB9kbfq>tK?tH[\EvWqS]b`o2OCtjg:?nUTwdjpcUm]y:pg5q24q7LlCOwQE^}}
r del l
r rpush l [lindex $mylist 0]
r rpush l [lindex $mylist 1]
assert_equal [r lindex l 0] [lindex $mylist 0]
assert_equal [r lindex l 1] [lindex $mylist 1]
}
tags {slow} {
test {ziplist implementation: value encoding and backlink} {
if {$::accurate} {set iterations 100} else {set iterations 10}
for {set j 0} {$j < $iterations} {incr j} {
r del l
set l {}
for {set i 0} {$i < 200} {incr i} {
randpath {
set data [string repeat x [randomInt 100000]]
} {
set data [randomInt 65536]
} {
set data [randomInt 4294967296]
} {
set data [randomInt 18446744073709551616]
}
lappend l $data
r rpush l $data
}
assert_equal [llength $l] [r llen l]
# Traverse backward
for {set i 199} {$i >= 0} {incr i -1} {
if {[lindex $l $i] ne [r lindex l $i]} {
assert_equal [lindex $l $i] [r lindex l $i]
}
}
}
}
test {ziplist implementation: encoding stress testing} {
for {set j 0} {$j < 200} {incr j} {
r del l
set l {}
set len [randomInt 400]
for {set i 0} {$i < $len} {incr i} {
set rv [randomValue]
randpath {
lappend l $rv
r rpush l $rv
} {
set l [concat [list $rv] $l]
r lpush l $rv
}
}
assert_equal [llength $l] [r llen l]
for {set i 0} {$i < $len} {incr i} {
if {[lindex $l $i] ne [r lindex l $i]} {
assert_equal [lindex $l $i] [r lindex l $i]
}
}
}
}
}
}

5
tests/unit/type/list-common.tcl Normal file
View File

@@ -0,0 +1,5 @@
# We need a value larger than list-max-ziplist-value to make sure
# the list has the right encoding when it is swapped in again.
array set largevalue {}
set largevalue(ziplist) "hello"
set largevalue(linkedlist) [string repeat "hello" 4]

112
tests/unit/type/list.tcl
View File

@@ -5,11 +5,7 @@ start_server {
"list-max-ziplist-entries" 256
}
} {
# We need a value larger than list-max-ziplist-value to make sure
# the list has the right encoding when it is swapped in again.
array set largevalue {}
set largevalue(ziplist) "hello"
set largevalue(linkedlist) [string repeat "hello" 4]
source "tests/unit/type/list-common.tcl"
test {LPUSH, RPUSH, LLENGTH, LINDEX - ziplist} {
# first lpush then rpush
@@ -152,8 +148,11 @@ start_server {
test "BLPOP with variadic LPUSH" {
set rd [redis_deferring_client]
r del blist target
if {$::valgrind} {after 100}
$rd blpop blist 0
if {$::valgrind} {after 100}
assert_equal 2 [r lpush blist foo bar]
if {$::valgrind} {after 100}
assert_equal {blist foo} [$rd read]
assert_equal bar [lindex [r lrange blist 0 -1] 0]
}
@@ -671,38 +670,6 @@ start_server {
assert_equal {} [trim_list $type 0 -6]
}
tags {"slow"} {
test "LTRIM stress testing - $type" {
set mylist {}
set startlen 32
r del mylist
# Start with the large value to ensure the
# right encoding is used.
r rpush mylist $large
lappend mylist $large
for {set i 0} {$i < $startlen} {incr i} {
set str [randomInt 9223372036854775807]
r rpush mylist $str
lappend mylist $str
}
for {set i 0} {$i < 1000} {incr i} {
set min [expr {int(rand()*$startlen)}]
set max [expr {$min+int(rand()*$startlen)}]
set mylist [lrange $mylist $min $max]
r ltrim mylist $min $max
assert_equal $mylist [r lrange mylist 0 -1]
for {set j [r llen mylist]} {$j < $startlen} {incr j} {
set str [randomInt 9223372036854775807]
r rpush mylist $str
lappend mylist $str
}
}
}
}
}
foreach {type large} [array get largevalue] {
@@ -760,76 +727,5 @@ start_server {
assert_equal 1 [r lrem myotherlist 1 2]
assert_equal 3 [r llen myotherlist]
}
}
}
start_server {
tags {list ziplist}
overrides {
"list-max-ziplist-value" 200000
"list-max-ziplist-entries" 256
}
} {
test {Explicit regression for a list bug} {
set mylist {49376042582 {BkG2o\pIC]4YYJa9cJ4GWZalG[4tin;1D2whSkCOW`mX;SFXGyS8sedcff3fQI^tgPCC@^Nu1J6o]meM@Lko]t_jRyo<xSJ1oObDYd`ppZuW6P@fS278YaOx=s6lvdFlMbP0[SbkI^Kr\HBXtuFaA^mDx:yzS4a[skiiPWhT<nNfAf=aQVfclcuwDrfe;iVuKdNvB9kbfq>tK?tH[\EvWqS]b`o2OCtjg:?nUTwdjpcUm]y:pg5q24q7LlCOwQE^}}
r del l
r rpush l [lindex $mylist 0]
r rpush l [lindex $mylist 1]
assert_equal [r lindex l 0] [lindex $mylist 0]
assert_equal [r lindex l 1] [lindex $mylist 1]
}
tags {slow} {
test {ziplist implementation: value encoding and backlink} {
for {set j 0} {$j < 100} {incr j} {
r del l
set l {}
for {set i 0} {$i < 200} {incr i} {
randpath {
set data [string repeat x [randomInt 100000]]
} {
set data [randomInt 65536]
} {
set data [randomInt 4294967296]
} {
set data [randomInt 18446744073709551616]
}
lappend l $data
r rpush l $data
}
assert_equal [llength $l] [r llen l]
# Traverse backward
for {set i 199} {$i >= 0} {incr i -1} {
if {[lindex $l $i] ne [r lindex l $i]} {
assert_equal [lindex $l $i] [r lindex l $i]
}
}
}
}
test {ziplist implementation: encoding stress testing} {
for {set j 0} {$j < 200} {incr j} {
r del l
set l {}
set len [randomInt 400]
for {set i 0} {$i < $len} {incr i} {
set rv [randomValue]
randpath {
lappend l $rv
r rpush l $rv
} {
set l [concat [list $rv] $l]
r lpush l $rv
}
}
assert_equal [llength $l] [r llen l]
for {set i 0} {$i < 200} {incr i} {
if {[lindex $l $i] ne [r lindex l $i]} {
assert_equal [lindex $l $i] [r lindex l $i]
}
}
}
}
}
}

2
tests/unit/type/zset.tcl
View File

@@ -527,7 +527,7 @@ start_server {tags {"zset"}} {
} elseif {$encoding == "skiplist"} {
r config set zset-max-ziplist-entries 0
r config set zset-max-ziplist-value 0
set elements 1000
if {$::accurate} {set elements 1000} else {set elements 100}
} else {
puts "Unknown sorted set encoding"
exit