Adding upstream version 5:7.2.4.upstream/5%7.2.4upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

4 files changed, 144 insertions, 0 deletions

diff --git a/tests/helpers/bg_block_op.tcl b/tests/helpers/bg_block_op.tcl
new file mode 100644
index 0000000..dc4e1a9
--- /dev/null
+++ b/tests/helpers/bg_block_op.tcl
@@ -0,0 +1,55 @@
+source tests/support/redis.tcl
+source tests/support/util.tcl
+
+set ::tlsdir "tests/tls"
+
+# This function sometimes writes sometimes blocking-reads from lists/sorted
+# sets. There are multiple processes like this executing at the same time
+# so that we have some chance to trap some corner condition if there is
+# a regression. For this to happen it is important that we narrow the key
+# space to just a few elements, and balance the operations so that it is
+# unlikely that lists and zsets just get more data without ever causing
+# blocking.
+proc bg_block_op {host port db ops tls} {
+    set r [redis $host $port 0 $tls]
+    $r client setname LOAD_HANDLER
+    $r select $db
+
+    for {set j 0} {$j < $ops} {incr j} {
+
+        # List side
+        set k list_[randomInt 10]
+        set k2 list_[randomInt 10]
+        set v [randomValue]
+
+        randpath {
+            randpath {
+                $r rpush $k $v
+            } {
+                $r lpush $k $v
+            }
+        } {
+            $r blpop $k 2
+        } {
+            $r blpop $k $k2 2
+        }
+
+        # Zset side
+        set k zset_[randomInt 10]
+        set k2 zset_[randomInt 10]
+        set v1 [randomValue]
+        set v2 [randomValue]
+
+        randpath {
+            $r zadd $k [randomInt 10000] $v
+        } {
+            $r zadd $k [randomInt 10000] $v [randomInt 10000] $v2
+        } {
+            $r bzpopmin $k 2
+        } {
+            $r bzpopmax $k 2
+        }
+    }
+}
+
+bg_block_op [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3] [lindex $argv 4]
diff --git a/tests/helpers/bg_complex_data.tcl b/tests/helpers/bg_complex_data.tcl
new file mode 100644
index 0000000..9c0044e
--- /dev/null
+++ b/tests/helpers/bg_complex_data.tcl
@@ -0,0 +1,13 @@
+source tests/support/redis.tcl
+source tests/support/util.tcl
+
+set ::tlsdir "tests/tls"
+
+proc bg_complex_data {host port db ops tls} {
+    set r [redis $host $port 0 $tls]
+    $r client setname LOAD_HANDLER
+    $r select $db
+    createComplexDataset $r $ops
+}
+
+bg_complex_data [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3] [lindex $argv 4]
diff --git a/tests/helpers/fake_redis_node.tcl b/tests/helpers/fake_redis_node.tcl
new file mode 100644
index 0000000..a12d87f
--- /dev/null
+++ b/tests/helpers/fake_redis_node.tcl
@@ -0,0 +1,58 @@
+# A fake Redis node for replaying predefined/expected traffic with a client.
+#
+# Usage: tclsh fake_redis_node.tcl PORT COMMAND REPLY [ COMMAND REPLY [ ... ] ]
+#
+# Commands are given as space-separated strings, e.g. "GET foo", and replies as
+# RESP-encoded replies minus the trailing \r\n, e.g. "+OK".
+
+set port [lindex $argv 0];
+set expected_traffic [lrange $argv 1 end];
+
+# Reads and parses a command from a socket and returns it as a space-separated
+# string, e.g. "set foo bar".
+proc read_command {sock} {
+    set char [read $sock 1]
+    switch $char {
+        * {
+            set numargs [gets $sock]
+            set result {}
+            for {set i 0} {$i<$numargs} {incr i} {
+                read $sock 1;       # dollar sign
+                set len [gets $sock]
+                set str [read $sock $len]
+                gets $sock;         # trailing \r\n
+                lappend result $str
+            }
+            return $result
+        }
+        {} {
+            # EOF
+            return {}
+        }
+        default {
+            # Non-RESP command
+            set rest [gets $sock]
+            return "$char$rest"
+        }
+    }
+}
+
+proc accept {sock host port} {
+    global expected_traffic
+    foreach {expect_cmd reply} $expected_traffic {
+        if {[eof $sock]} {break}
+        set cmd [read_command $sock]
+        if {[string equal -nocase $cmd $expect_cmd]} {
+            puts $sock $reply
+            flush $sock
+        } else {
+            puts $sock "-ERR unexpected command $cmd"
+            break
+        }
+    }
+    close $sock
+}
+
+socket -server accept $port
+after 5000 set done timeout
+vwait done
diff --git a/tests/helpers/gen_write_load.tcl b/tests/helpers/gen_write_load.tcl
new file mode 100644
index 0000000..568f5cd
--- /dev/null
+++ b/tests/helpers/gen_write_load.tcl
@@ -0,0 +1,18 @@
+source tests/support/redis.tcl
+
+set ::tlsdir "tests/tls"
+
+proc gen_write_load {host port seconds tls} {
+    set start_time [clock seconds]
+    set r [redis $host $port 1 $tls]
+    $r client setname LOAD_HANDLER
+    $r select 9
+    while 1 {
+        $r set [expr rand()] [expr rand()]
+        if {[clock seconds]-$start_time > $seconds} {
+            exit 0
+        }
+    }
+}
+
+gen_write_load [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3]