123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377 |
- 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
- }
- 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]
- }
- 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"
- }
- 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
- }
- }
- }
- proc randomInt {max} {
- expr {int(rand()*$max)}
- }
- 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 {
- randomSignedInt 1000
- } {
- randpath {randomSignedInt 2000000000} {randomSignedInt 4000000000}
- } {
- randpath {randomSignedInt 1000000000000}
- } {
- randpath {randstring 0 256 alpha} \
- {randstring 0 256 compr} \
- {randstring 0 256 binary}
- }
- }
- proc randomKey {} {
- randpath {
- randomInt 1000
- } {
- randpath {randomInt 2000000000} {randomInt 4000000000}
- } {
- randpath {randomInt 1000000000000}
- } {
- 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} {
- }
- {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."
- }
- }
- 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
- }
- }
- proc start_write_load {host port seconds} {
- set tclsh [info nameofexecutable]
- exec $tclsh tests/helpers/gen_write_load.tcl $host $port $seconds &
- }
- proc stop_write_load {handle} {
- catch {exec /bin/kill -9 $handle}
- }
|