summaryrefslogtreecommitdiff
path: root/tests/support/util.tcl
diff options
context:
space:
mode:
authorYossi Gottlieb <yossigo@gmail.com>2021-06-09 15:13:24 +0300
committerGitHub <noreply@github.com>2021-06-09 15:13:24 +0300
commit8a86bca5ed09094b561284fcb5b1fc416a4016dc (patch)
tree1507189b397646325d7270fd522c622f635e73ce /tests/support/util.tcl
parentc396fd91a039feb5114e79f6f91459a0b1f74346 (diff)
downloadredis-8a86bca5ed09094b561284fcb5b1fc416a4016dc.tar.gz
Improve test suite to handle external servers better. (#9033)
This commit revives the improves the ability to run the test suite against external servers, instead of launching and managing `redis-server` processes as part of the test fixture. This capability existed in the past, using the `--host` and `--port` options. However, it was quite limited and mostly useful when running a specific tests. Attempting to run larger chunks of the test suite experienced many issues: * Many tests depend on being able to start and control `redis-server` themselves, and there's no clear distinction between external server compatible and other tests. * Cluster mode is not supported (resulting with `CROSSSLOT` errors). This PR cleans up many things and makes it possible to run the entire test suite against an external server. It also provides more fine grained controls to handle cases where the external server supports a subset of the Redis commands, limited number of databases, cluster mode, etc. The tests directory now contains a `README.md` file that describes how this works. This commit also includes additional cleanups and fixes: * Tests can now be tagged. * Tag-based selection is now unified across `start_server`, `tags` and `test`. * More information is provided about skipped or ignored tests. * Repeated patterns in tests have been extracted to common procedures, both at a global level and on a per-test file basis. * Cleaned up some cases where test setup was based on a previous test executing (a major anti-pattern that repeats itself in many places). * Cleaned up some cases where test teardown was not part of a test (in the future we should have dedicated teardown code that executes even when tests fail). * Fixed some tests that were flaky running on external servers.
Diffstat (limited to 'tests/support/util.tcl')
-rw-r--r--tests/support/util.tcl77
1 files changed, 70 insertions, 7 deletions
diff --git a/tests/support/util.tcl b/tests/support/util.tcl
index 8afb30cc4..092306e11 100644
--- a/tests/support/util.tcl
+++ b/tests/support/util.tcl
@@ -250,13 +250,19 @@ proc findKeyWithType {r type} {
}
proc createComplexDataset {r ops {opt {}}} {
+ set useexpire [expr {[lsearch -exact $opt useexpire] != -1}]
+ if {[lsearch -exact $opt usetag] != -1} {
+ set tag "{t}"
+ } else {
+ set tag ""
+ }
for {set j 0} {$j < $ops} {incr j} {
- set k [randomKey]
- set k2 [randomKey]
+ set k [randomKey]$tag
+ set k2 [randomKey]$tag
set f [randomValue]
set v [randomValue]
- if {[lsearch -exact $opt useexpire] != -1} {
+ if {$useexpire} {
if {rand() < 0.1} {
{*}$r expire [randomKey] [randomInt 2]
}
@@ -353,8 +359,15 @@ proc formatCommand {args} {
proc csvdump r {
set o {}
- for {set db 0} {$db < 16} {incr db} {
- {*}$r select $db
+ if {$::singledb} {
+ set maxdb 1
+ } else {
+ set maxdb 16
+ }
+ for {set db 0} {$db < $maxdb} {incr db} {
+ if {!$::singledb} {
+ {*}$r select $db
+ }
foreach k [lsort [{*}$r keys *]] {
set type [{*}$r type $k]
append o [csvstring $db] , [csvstring $k] , [csvstring $type] ,
@@ -396,7 +409,9 @@ proc csvdump r {
}
}
}
- {*}$r select 9
+ if {!$::singledb} {
+ {*}$r select 9
+ }
return $o
}
@@ -540,7 +555,7 @@ proc stop_bg_complex_data {handle} {
catch {exec /bin/kill -9 $handle}
}
-proc populate {num prefix size} {
+proc populate {num {prefix key:} {size 3}} {
set rd [redis_deferring_client]
for {set j 0} {$j < $num} {incr j} {
$rd set $prefix$j [string repeat A $size]
@@ -777,6 +792,30 @@ proc punsubscribe {client {channels {}}} {
consume_subscribe_messages $client punsubscribe $channels
}
+proc debug_digest_value {key} {
+ if {!$::ignoredigest} {
+ r debug digest-value $key
+ } else {
+ return "dummy-digest-value"
+ }
+}
+
+proc wait_for_blocked_client {} {
+ wait_for_condition 50 100 {
+ [s blocked_clients] ne 0
+ } else {
+ fail "no blocked clients"
+ }
+}
+
+proc wait_for_blocked_clients_count {count {maxtries 100} {delay 10}} {
+ wait_for_condition $maxtries $delay {
+ [s blocked_clients] == $count
+ } else {
+ fail "Timeout waiting for blocked clients"
+ }
+}
+
proc read_from_aof {fp} {
# Input fp is a blocking binary file descriptor of an opened AOF file.
if {[gets $fp count] == -1} return ""
@@ -802,3 +841,27 @@ proc assert_aof_content {aof_path patterns} {
assert_match [lindex $patterns $j] [read_from_aof $fp]
}
}
+
+proc config_set {param value {options {}}} {
+ set mayfail 0
+ foreach option $options {
+ switch $option {
+ "mayfail" {
+ set mayfail 1
+ }
+ default {
+ error "Unknown option $option"
+ }
+ }
+ }
+
+ if {[catch {r config set $param $value} err]} {
+ if {!$mayfail} {
+ error $err
+ } else {
+ if {$::verbose} {
+ puts "Ignoring CONFIG SET $param $value failure: $err"
+ }
+ }
+ }
+}