test suite improvements pulled back from 7.0 for cherry picked commits

3 files changed, 46 insertions, 6 deletions

diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl
index 978163e98..fa9c06501 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 1d098b543..f6dbc5197 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 72b3fab85..5a4cbd49f 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 <port>      TCP port to use against external host."
         "--baseport <port>  Initial port number for spawned redis servers."
         "--portcount <num>  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