diff options
Diffstat (limited to 'examples/redis-unstable/tests/helpers')
4 files changed, 179 insertions, 0 deletions
diff --git a/examples/redis-unstable/tests/helpers/bg_block_op.tcl b/examples/redis-unstable/tests/helpers/bg_block_op.tcl new file mode 100644 index 0000000..dc4e1a9 --- /dev/null +++ b/examples/redis-unstable/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/examples/redis-unstable/tests/helpers/bg_complex_data.tcl b/examples/redis-unstable/tests/helpers/bg_complex_data.tcl new file mode 100644 index 0000000..9c0044e --- /dev/null +++ b/examples/redis-unstable/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/examples/redis-unstable/tests/helpers/fake_redis_node.tcl b/examples/redis-unstable/tests/helpers/fake_redis_node.tcl new file mode 100644 index 0000000..0f69d0a --- /dev/null +++ b/examples/redis-unstable/tests/helpers/fake_redis_node.tcl @@ -0,0 +1,60 @@ +# 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 +} + +set sockfd [socket -server accept -myaddr 127.0.0.1 $port] +after 5000 set done timeout +vwait done +close $sockfd + diff --git a/examples/redis-unstable/tests/helpers/gen_write_load.tcl b/examples/redis-unstable/tests/helpers/gen_write_load.tcl new file mode 100644 index 0000000..7b4975c --- /dev/null +++ b/examples/redis-unstable/tests/helpers/gen_write_load.tcl @@ -0,0 +1,51 @@ +# +# Copyright (c) 2009-Present, Redis Ltd. +# All rights reserved. +# +# Copyright (c) 2024-present, Valkey contributors. +# All rights reserved. +# +# Licensed under your choice of (a) the Redis Source Available License 2.0 +# (RSALv2); or (b) the Server Side Public License v1 (SSPLv1); or (c) the +# GNU Affero General Public License v3 (AGPLv3). +# +# Portions of this file are available under BSD3 terms; see REDISCONTRIBUTIONS for more information. +# + +source tests/support/redis.tcl + +set ::tlsdir "tests/tls" + +# Continuously sends SET commands to the server. If key is omitted, a random key +# is used for every SET command. The value is always random. +proc gen_write_load {host port seconds tls {key ""} {size 0} {sleep 0}} { + set start_time [clock seconds] + set r [redis $host $port 1 $tls] + $r client setname LOAD_HANDLER + catch {$r select 9} ;# select 9 will fail in cluster mode + + # fixed size value + if {$size != 0} { + set value [string repeat "x" $size] + } + + while 1 { + if {$size == 0} { + set value [expr rand()] + } + + if {$key == ""} { + $r set [expr rand()] $value + } else { + $r set $key $value + } + if {[clock seconds]-$start_time > $seconds} { + exit 0 + } + if {$sleep ne 0} { + after $sleep + } + } +} + +gen_write_load [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3] [lindex $argv 4] [lindex $argv 5] [lindex $argv 6] |