X-Git-Url: https://git.saurik.com/redis.git/blobdiff_plain/9cf9e6f197a0270a86b26ddfca65a6faa72da893..6bdcd50b56ba295808729e198bd3b3e5284aba42:/tests/support/util.tcl diff --git a/tests/support/util.tcl b/tests/support/util.tcl index a084df90..48d06b74 100644 --- a/tests/support/util.tcl +++ b/tests/support/util.tcl @@ -25,18 +25,41 @@ proc zlistAlikeSort {a b} { 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]} { + if {[regexp "\r\n$property:(.*?)\r\n" [{*}$r info] _ value]} { set _ $value } } proc waitForBgsave r { while 1 { - if {[status r bgsave_in_progress] eq 1} { - puts -nonewline "\nWaiting for background save to finish... " - flush stdout + 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 @@ -46,9 +69,11 @@ proc waitForBgsave r { proc waitForBgrewriteaof r { while 1 { - if {[status r bgrewriteaof_in_progress] eq 1} { - puts -nonewline "\nWaiting for background AOF rewrite to finish... " - flush stdout + 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 @@ -56,10 +81,28 @@ proc waitForBgrewriteaof r { } } +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] @@ -68,13 +111,13 @@ proc randpath args { proc randomValue {} { randpath { # Small enough to likely collide - randomInt 1000 + randomSignedInt 1000 } { # 32 bit compressible signed/unsigned - randpath {randomInt 2000000000} {randomInt 4000000000} + randpath {randomSignedInt 2000000000} {randomSignedInt 4000000000} } { # 64 bit - randpath {randomInt 1000000000000} + randpath {randomSignedInt 1000000000000} } { # Random string randpath {randstring 0 256 alpha} \ @@ -100,11 +143,32 @@ proc randomKey {} { } } -proc createComplexDataset {r ops} { +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()}] } { @@ -118,21 +182,23 @@ proc createComplexDataset {r ops} { } { randpath {set d +inf} {set d -inf} } - set t [$r type $k] + set t [{*}$r type $k] if {$t eq {none}} { randpath { - $r set $k $v + {*}$r set $k $v } { - $r lpush $k $v + {*}$r lpush $k $v } { - $r sadd $k $v + {*}$r sadd $k $v } { - $r zadd $k $d $v + {*}$r zadd $k $d $v } { - $r hset $k $f $v + {*}$r hset $k $f $v + } { + {*}$r del $k } - set t [$r type $k] + set t [{*}$r type $k] } switch $t { @@ -140,24 +206,107 @@ proc createComplexDataset {r ops} { # Nothing to do } {list} { - randpath {$r lpush $k $v} \ - {$r rpush $k $v} \ - {$r lrem $k 0 $v} \ - {$r rpop $k} \ - {$r lpop $k} + 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} + 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} + 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} + 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 {} + foreach k [lsort [{*}$r keys *]] { + set type [{*}$r type $k] + append o [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" + } + } + } + return $o +} + +proc csvstring s { + return "\"$s\"" +} + +proc roundFloat f { + format "%.10g" $f +}