diff options
Diffstat (limited to 'tests/helpers')
-rw-r--r-- | tests/helpers/bg_block_op.tcl | 55 | ||||
-rw-r--r-- | tests/helpers/bg_complex_data.tcl | 13 | ||||
-rw-r--r-- | tests/helpers/fake_redis_node.tcl | 58 | ||||
-rw-r--r-- | tests/helpers/gen_write_load.tcl | 18 |
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] |