summaryrefslogtreecommitdiffstats
path: root/tests/helpers
diff options
context:
space:
mode:
Diffstat (limited to 'tests/helpers')
-rw-r--r--tests/helpers/bg_block_op.tcl55
-rw-r--r--tests/helpers/bg_complex_data.tcl13
-rw-r--r--tests/helpers/fake_redis_node.tcl58
-rw-r--r--tests/helpers/gen_write_load.tcl18
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]