From 619174117de0446a283a93adac06dbe8109938cd Mon Sep 17 00:00:00 2001 From: antirez Date: Tue, 12 Jul 2011 09:40:54 +0200 Subject: [PATCH] new test engine backported to 2.4 --- tests/assets/default.conf | 182 +++++++++------ tests/integration/aof.tcl | 27 +++ tests/integration/replication-2.tcl | 27 +++ tests/integration/replication-3.tcl | 31 +++ tests/integration/replication.tcl | 39 +--- tests/support/server.tcl | 13 +- tests/support/test.tcl | 99 ++------- tests/test_helper.tcl | 330 +++++++++++++++++++++------- tests/unit/expire.tcl | 2 +- tests/unit/other.tcl | 71 +++--- tests/unit/slowlog.tcl | 2 +- tests/unit/type/list-2.tcl | 44 ++++ tests/unit/type/list-3.tcl | 70 ++++++ tests/unit/type/list-common.tcl | 5 + tests/unit/type/list.tcl | 112 +--------- tests/unit/type/zset.tcl | 2 +- 16 files changed, 638 insertions(+), 418 deletions(-) create mode 100644 tests/integration/replication-2.tcl create mode 100644 tests/integration/replication-3.tcl create mode 100644 tests/unit/type/list-2.tcl create mode 100644 tests/unit/type/list-3.tcl create mode 100644 tests/unit/type/list-common.tcl diff --git a/tests/assets/default.conf b/tests/assets/default.conf index 15d70ffbde..75334426b7 100644 --- a/tests/assets/default.conf +++ b/tests/assets/default.conf @@ -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 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 +# 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 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 +# 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) diff --git a/tests/integration/aof.tcl b/tests/integration/aof.tcl index 927969b627..a554f9ef13 100644 --- a/tests/integration/aof.tcl +++ b/tests/integration/aof.tcl @@ -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 + } + } } diff --git a/tests/integration/replication-2.tcl b/tests/integration/replication-2.tcl new file mode 100644 index 0000000000..5450bdd850 --- /dev/null +++ b/tests/integration/replication-2.tcl @@ -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] + } + } +} diff --git a/tests/integration/replication-3.tcl b/tests/integration/replication-3.tcl new file mode 100644 index 0000000000..e660bf4e52 --- /dev/null +++ b/tests/integration/replication-3.tcl @@ -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] + } + } +} diff --git a/tests/integration/replication.tcl b/tests/integration/replication.tcl index 227356b24d..0a1cd409fe 100644 --- a/tests/integration/replication.tcl +++ b/tests/integration/replication.tcl @@ -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} } diff --git a/tests/support/server.tcl b/tests/support/server.tcl index 4f48d22dca..3fa1725f3c 100644 --- a/tests/support/server.tcl +++ b/tests/support/server.tcl @@ -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 } diff --git a/tests/support/test.tcl b/tests/support/test.tcl index dff2d29769..4e68905a5a 100644 --- a/tests/support/test.tcl +++ b/tests/support/test.tcl @@ -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" } } } diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index 2c1daf944c..fbd9d3b312 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -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 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 + } + } } diff --git a/tests/unit/expire.tcl b/tests/unit/expire.tcl index 6f16ed5895..415a0f5380 100644 --- a/tests/unit/expire.tcl +++ b/tests/unit/expire.tcl @@ -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 diff --git a/tests/unit/other.tcl b/tests/unit/other.tcl index c090d1d2c2..702c291f9a 100644 --- a/tests/unit/other.tcl +++ b/tests/unit/other.tcl @@ -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} } diff --git a/tests/unit/slowlog.tcl b/tests/unit/slowlog.tcl index d7fca782f9..55a71e9859 100644 --- a/tests/unit/slowlog.tcl +++ b/tests/unit/slowlog.tcl @@ -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} diff --git a/tests/unit/type/list-2.tcl b/tests/unit/type/list-2.tcl new file mode 100644 index 0000000000..bf6a055eba --- /dev/null +++ b/tests/unit/type/list-2.tcl @@ -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 + } + } + } + } + } +} diff --git a/tests/unit/type/list-3.tcl b/tests/unit/type/list-3.tcl new file mode 100644 index 0000000000..9410022fdc --- /dev/null +++ b/tests/unit/type/list-3.tcl @@ -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_jRyotK?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] + } + } + } + } + } +} diff --git a/tests/unit/type/list-common.tcl b/tests/unit/type/list-common.tcl new file mode 100644 index 0000000000..ab45f0b31b --- /dev/null +++ b/tests/unit/type/list-common.tcl @@ -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] diff --git a/tests/unit/type/list.tcl b/tests/unit/type/list.tcl index 616abd21a0..ff178db417 100644 --- a/tests/unit/type/list.tcl +++ b/tests/unit/type/list.tcl @@ -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_jRyotK?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] - } - } - } - } } } diff --git a/tests/unit/type/zset.tcl b/tests/unit/type/zset.tcl index 46d40f6fb1..41f5f588f5 100644 --- a/tests/unit/type/zset.tcl +++ b/tests/unit/type/zset.tcl @@ -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