From d92f2f5ad616b2ddb22dda4359917be7c66b0a17 Mon Sep 17 00:00:00 2001 From: Oran Agra Date: Tue, 12 Apr 2022 12:42:44 +0300 Subject: [PATCH] test suite improvements pulled back from 7.0 for cherry picked commits --- tests/support/redis.tcl | 8 ++++++++ tests/support/util.tcl | 19 ++++++++++++++++++- tests/test_helper.tcl | 25 ++++++++++++++++++++----- 3 files changed, 46 insertions(+), 6 deletions(-) diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl index 978163e98c..fa9c065013 100644 --- a/tests/support/redis.tcl +++ b/tests/support/redis.tcl @@ -254,6 +254,12 @@ proc ::redis::redis_read_bool fd { return -code error "Bad protocol, '$v' as bool type" } +proc ::redis::redis_read_verbatim_str fd { + set v [redis_bulk_read $fd] + # strip the first 4 chars ("txt:") + return [string range $v 4 end] +} + proc ::redis::redis_read_reply {id fd} { if {$::redis::readraw($id)} { return [redis_read_line $fd] @@ -268,6 +274,7 @@ proc ::redis::redis_read_reply {id fd} { + {return [redis_read_line $fd]} , {return [expr {double([redis_read_line $fd])}]} # {return [redis_read_bool $fd]} + = {return [redis_read_verbatim_str $fd]} - {return -code error [redis_read_line $fd]} $ {return [redis_bulk_read $fd]} > - @@ -317,6 +324,7 @@ proc ::redis::redis_readable {fd id} { : - + {redis_call_callback $id reply [string range $line 1 end-1]} - {redis_call_callback $id err [string range $line 1 end-1]} + ( {redis_call_callback $id reply [string range $line 1 end-1]} $ { dict set ::redis::state($id) bulk \ [expr [string range $line 1 end-1]+2] diff --git a/tests/support/util.tcl b/tests/support/util.tcl index 1d098b5435..f6dbc51979 100644 --- a/tests/support/util.tcl +++ b/tests/support/util.tcl @@ -770,4 +770,21 @@ proc psubscribe {client channels} { proc punsubscribe {client {channels {}}} { $client punsubscribe {*}$channels consume_subscribe_messages $client punsubscribe $channels -} \ No newline at end of file +} + +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" + } +} + diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl index 72b3fab856..5a4cbd49f4 100644 --- a/tests/test_helper.tcl +++ b/tests/test_helper.tcl @@ -116,6 +116,7 @@ set ::stop_on_failure 0 set ::dump_logs 0 set ::loop 0 set ::tlsdir "tests/tls" +set ::singledb 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 @@ -193,7 +194,7 @@ proc reconnect {args} { dict set srv "client" $client # select the right db when we don't have to authenticate - if {![dict exists $config "requirepass"]} { + if {![dict exists $config "requirepass"] && !$::singledb} { $client select 9 } @@ -212,8 +213,14 @@ proc redis_deferring_client {args} { set client [redis [srv $level "host"] [srv $level "port"] 1 $::tls] # select the right db and read the response (OK) - $client select 9 - $client read + if {!$::singledb} { + $client select 9 + $client read + } else { + # For timing/symmetry with the above select + $client ping + $client read + } return $client } @@ -227,8 +234,13 @@ proc redis_client {args} { # create client that defers reading reply set client [redis [srv $level "host"] [srv $level "port"] 0 $::tls] - # select the right db and read the response (OK) - $client select 9 + # select the right db and read the response (OK), or at least ping + # the server if we're in a singledb mode. + if {$::singledb} { + $client ping + } else { + $client select 9 + } return $client } @@ -565,6 +577,7 @@ proc print_help_screen {} { "--port TCP port to use against external host." "--baseport Initial port number for spawned redis servers." "--portcount Port range for spawned redis servers." + "--singledb Use a single database, avoid SELECT." "--help Print this help screen." } "\n"] } @@ -671,6 +684,8 @@ for {set j 0} {$j < [llength $argv]} {incr j} { } elseif {$opt eq {--timeout}} { set ::timeout $arg incr j + } elseif {$opt eq {--singledb}} { + set ::singledb 1 } elseif {$opt eq {--help}} { print_help_screen exit 0