summaryrefslogtreecommitdiff
path: root/tests/support/util.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/support/util.tcl')
-rw-r--r--tests/support/util.tcl377
1 files changed, 377 insertions, 0 deletions
diff --git a/tests/support/util.tcl b/tests/support/util.tcl
new file mode 100644
index 0000000..64c36b3
--- /dev/null
+++ b/tests/support/util.tcl
@@ -0,0 +1,377 @@
+proc randstring {min max {type binary}} {
+ set len [expr {$min+int(rand()*($max-$min+1))}]
+ set output {}
+ if {$type eq {binary}} {
+ set minval 0
+ set maxval 255
+ } elseif {$type eq {alpha}} {
+ set minval 48
+ set maxval 122
+ } elseif {$type eq {compr}} {
+ set minval 48
+ set maxval 52
+ }
+ while {$len} {
+ append output [format "%c" [expr {$minval+int(rand()*($maxval-$minval+1))}]]
+ incr len -1
+ }
+ return $output
+}
+
+# Useful for some test
+proc zlistAlikeSort {a b} {
+ if {[lindex $a 0] > [lindex $b 0]} {return 1}
+ if {[lindex $a 0] < [lindex $b 0]} {return -1}
+ string compare [lindex $a 1] [lindex $b 1]
+}
+
+# Return all log lines starting with the first line that contains a warning.
+# Generally, this will be an assertion error with a stack trace.
+proc warnings_from_file {filename} {
+ set lines [split [exec cat $filename] "\n"]
+ set matched 0
+ set logall 0
+ set result {}
+ foreach line $lines {
+ if {[string match {*REDIS BUG REPORT START*} $line]} {
+ set logall 1
+ }
+ if {[regexp {^\[\d+\]\s+\d+\s+\w+\s+\d{2}:\d{2}:\d{2} \#} $line]} {
+ set matched 1
+ }
+ if {$logall || $matched} {
+ lappend result $line
+ }
+ }
+ join $result "\n"
+}
+
+# Return value for INFO property
+proc status {r property} {
+ if {[regexp "\r\n$property:(.*?)\r\n" [{*}$r info] _ value]} {
+ set _ $value
+ }
+}
+
+proc waitForBgsave r {
+ while 1 {
+ if {[status r rdb_bgsave_in_progress] eq 1} {
+ if {$::verbose} {
+ puts -nonewline "\nWaiting for background save to finish... "
+ flush stdout
+ }
+ after 1000
+ } else {
+ break
+ }
+ }
+}
+
+proc waitForBgrewriteaof r {
+ while 1 {
+ if {[status r aof_rewrite_in_progress] eq 1} {
+ if {$::verbose} {
+ puts -nonewline "\nWaiting for background AOF rewrite to finish... "
+ flush stdout
+ }
+ after 1000
+ } else {
+ break
+ }
+ }
+}
+
+proc wait_for_sync r {
+ while 1 {
+ if {[status $r master_link_status] eq "down"} {
+ after 10
+ } else {
+ break
+ }
+ }
+}
+
+# Random integer between 0 and max (excluded).
+proc randomInt {max} {
+ expr {int(rand()*$max)}
+}
+
+# Random signed integer between -max and max (both extremes excluded).
+proc randomSignedInt {max} {
+ set i [randomInt $max]
+ if {rand() > 0.5} {
+ set i -$i
+ }
+ return $i
+}
+
+proc randpath args {
+ set path [expr {int(rand()*[llength $args])}]
+ uplevel 1 [lindex $args $path]
+}
+
+proc randomValue {} {
+ randpath {
+ # Small enough to likely collide
+ randomSignedInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomSignedInt 2000000000} {randomSignedInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomSignedInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 0 256 alpha} \
+ {randstring 0 256 compr} \
+ {randstring 0 256 binary}
+ }
+}
+
+proc randomKey {} {
+ randpath {
+ # Small enough to likely collide
+ randomInt 1000
+ } {
+ # 32 bit compressible signed/unsigned
+ randpath {randomInt 2000000000} {randomInt 4000000000}
+ } {
+ # 64 bit
+ randpath {randomInt 1000000000000}
+ } {
+ # Random string
+ randpath {randstring 1 256 alpha} \
+ {randstring 1 256 compr}
+ }
+}
+
+proc findKeyWithType {r type} {
+ for {set j 0} {$j < 20} {incr j} {
+ set k [{*}$r randomkey]
+ if {$k eq {}} {
+ return {}
+ }
+ if {[{*}$r type $k] eq $type} {
+ return $k
+ }
+ }
+ return {}
+}
+
+proc createComplexDataset {r ops {opt {}}} {
+ for {set j 0} {$j < $ops} {incr j} {
+ set k [randomKey]
+ set k2 [randomKey]
+ set f [randomValue]
+ set v [randomValue]
+
+ if {[lsearch -exact $opt useexpire] != -1} {
+ if {rand() < 0.1} {
+ {*}$r expire [randomKey] [randomInt 2]
+ }
+ }
+
+ randpath {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ set d [expr {rand()}]
+ } {
+ randpath {set d +inf} {set d -inf}
+ }
+ set t [{*}$r type $k]
+
+ if {$t eq {none}} {
+ randpath {
+ {*}$r set $k $v
+ } {
+ {*}$r lpush $k $v
+ } {
+ {*}$r sadd $k $v
+ } {
+ {*}$r zadd $k $d $v
+ } {
+ {*}$r hset $k $f $v
+ } {
+ {*}$r del $k
+ }
+ set t [{*}$r type $k]
+ }
+
+ switch $t {
+ {string} {
+ # Nothing to do
+ }
+ {list} {
+ randpath {{*}$r lpush $k $v} \
+ {{*}$r rpush $k $v} \
+ {{*}$r lrem $k 0 $v} \
+ {{*}$r rpop $k} \
+ {{*}$r lpop $k}
+ }
+ {set} {
+ randpath {{*}$r sadd $k $v} \
+ {{*}$r srem $k $v} \
+ {
+ set otherset [findKeyWithType {*}$r set]
+ if {$otherset ne {}} {
+ randpath {
+ {*}$r sunionstore $k2 $k $otherset
+ } {
+ {*}$r sinterstore $k2 $k $otherset
+ } {
+ {*}$r sdiffstore $k2 $k $otherset
+ }
+ }
+ }
+ }
+ {zset} {
+ randpath {{*}$r zadd $k $d $v} \
+ {{*}$r zrem $k $v} \
+ {
+ set otherzset [findKeyWithType {*}$r zset]
+ if {$otherzset ne {}} {
+ randpath {
+ {*}$r zunionstore $k2 2 $k $otherzset
+ } {
+ {*}$r zinterstore $k2 2 $k $otherzset
+ }
+ }
+ }
+ }
+ {hash} {
+ randpath {{*}$r hset $k $f $v} \
+ {{*}$r hdel $k $f}
+ }
+ }
+ }
+}
+
+proc formatCommand {args} {
+ set cmd "*[llength $args]\r\n"
+ foreach a $args {
+ append cmd "$[string length $a]\r\n$a\r\n"
+ }
+ set _ $cmd
+}
+
+proc csvdump r {
+ set o {}
+ for {set db 0} {$db < 16} {incr db} {
+ {*}$r select $db
+ foreach k [lsort [{*}$r keys *]] {
+ set type [{*}$r type $k]
+ append o [csvstring $db] , [csvstring $k] , [csvstring $type] ,
+ switch $type {
+ string {
+ append o [csvstring [{*}$r get $k]] "\n"
+ }
+ list {
+ foreach e [{*}$r lrange $k 0 -1] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ set {
+ foreach e [lsort [{*}$r smembers $k]] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ zset {
+ foreach e [{*}$r zrange $k 0 -1 withscores] {
+ append o [csvstring $e] ,
+ }
+ append o "\n"
+ }
+ hash {
+ set fields [{*}$r hgetall $k]
+ set newfields {}
+ foreach {k v} $fields {
+ lappend newfields [list $k $v]
+ }
+ set fields [lsort -index 0 $newfields]
+ foreach kv $fields {
+ append o [csvstring [lindex $kv 0]] ,
+ append o [csvstring [lindex $kv 1]] ,
+ }
+ append o "\n"
+ }
+ }
+ }
+ }
+ {*}$r select 9
+ return $o
+}
+
+proc csvstring s {
+ return "\"$s\""
+}
+
+proc roundFloat f {
+ format "%.10g" $f
+}
+
+proc find_available_port start {
+ for {set j $start} {$j < $start+1024} {incr j} {
+ if {[catch {set fd1 [socket 127.0.0.1 $j]}] &&
+ [catch {set fd2 [socket 127.0.0.1 [expr $j+10000]]}]} {
+ return $j
+ } else {
+ catch {
+ close $fd1
+ close $fd2
+ }
+ }
+ }
+ if {$j == $start+1024} {
+ error "Can't find a non busy port in the $start-[expr {$start+1023}] range."
+ }
+}
+
+# Test if TERM looks like to support colors
+proc color_term {} {
+ expr {[info exists ::env(TERM)] && [string match *xterm* $::env(TERM)]}
+}
+
+proc colorstr {color str} {
+ if {[color_term]} {
+ set b 0
+ if {[string range $color 0 4] eq {bold-}} {
+ set b 1
+ set color [string range $color 5 end]
+ }
+ switch $color {
+ red {set colorcode {31}}
+ green {set colorcode {32}}
+ yellow {set colorcode {33}}
+ blue {set colorcode {34}}
+ magenta {set colorcode {35}}
+ cyan {set colorcode {36}}
+ white {set colorcode {37}}
+ default {set colorcode {37}}
+ }
+ if {$colorcode ne {}} {
+ return "\033\[$b;${colorcode};49m$str\033\[0m"
+ }
+ } else {
+ return $str
+ }
+}
+
+# Execute a background process writing random data for the specified number
+# of seconds to the specified Redis instance.
+proc start_write_load {host port seconds} {
+ set tclsh [info nameofexecutable]
+ exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds &
+}
+
+# Stop a process generating write load executed with start_write_load.
+proc stop_write_load {handle} {
+ catch {exec /bin/kill -9 $handle}
+}
generated by cgit v1.2.3 (git 2.39.1) at 2025-12-30 16:35:05 +0000