123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412 |
- # Compare Redis commands against Tcl implementations of the same commands.
- proc count_bits s {
- binary scan $s b* bits
- string length [regsub -all {0} $bits {}]
- }
- proc simulate_bit_op {op args} {
- set maxlen 0
- set j 0
- set count [llength $args]
- foreach a $args {
- binary scan $a b* bits
- set b($j) $bits
- if {[string length $bits] > $maxlen} {
- set maxlen [string length $bits]
- }
- incr j
- }
- for {set j 0} {$j < $count} {incr j} {
- if {[string length $b($j)] < $maxlen} {
- append b($j) [string repeat 0 [expr $maxlen-[string length $b($j)]]]
- }
- }
- set out {}
- for {set x 0} {$x < $maxlen} {incr x} {
- set bit [string range $b(0) $x $x]
- if {$op eq {not}} {set bit [expr {!$bit}]}
- for {set j 1} {$j < $count} {incr j} {
- set bit2 [string range $b($j) $x $x]
- switch $op {
- and {set bit [expr {$bit & $bit2}]}
- or {set bit [expr {$bit | $bit2}]}
- xor {set bit [expr {$bit ^ $bit2}]}
- }
- }
- append out $bit
- }
- binary format b* $out
- }
- start_server {tags {"bitops"}} {
- test {BITCOUNT returns 0 against non existing key} {
- r bitcount no-key
- } 0
- test {BITCOUNT returns 0 with out of range indexes} {
- r set str "xxxx"
- r bitcount str 4 10
- } 0
- test {BITCOUNT returns 0 with negative indexes where start > end} {
- r set str "xxxx"
- r bitcount str -6 -7
- } 0
- catch {unset num}
- foreach vec [list "" "\xaa" "\x00\x00\xff" "foobar" "123"] {
- incr num
- test "BITCOUNT against test vector #$num" {
- r set str $vec
- assert {[r bitcount str] == [count_bits $vec]}
- }
- }
- test {BITCOUNT fuzzing without start/end} {
- for {set j 0} {$j < 100} {incr j} {
- set str [randstring 0 3000]
- r set str $str
- assert {[r bitcount str] == [count_bits $str]}
- }
- }
- test {BITCOUNT fuzzing with start/end} {
- for {set j 0} {$j < 100} {incr j} {
- set str [randstring 0 3000]
- r set str $str
- set l [string length $str]
- set start [randomInt $l]
- set end [randomInt $l]
- if {$start > $end} {
- lassign [list $end $start] start end
- }
- assert {[r bitcount str $start $end] == [count_bits [string range $str $start $end]]}
- }
- }
- test {BITCOUNT with start, end} {
- r set s "foobar"
- assert_equal [r bitcount s 0 -1] [count_bits "foobar"]
- assert_equal [r bitcount s 1 -2] [count_bits "ooba"]
- assert_equal [r bitcount s -2 1] [count_bits ""]
- assert_equal [r bitcount s 0 1000] [count_bits "foobar"]
- }
- test {BITCOUNT syntax error #1} {
- catch {r bitcount s 0} e
- set e
- } {ERR*syntax*}
- test {BITCOUNT regression test for github issue #582} {
- r del foo
- r setbit foo 0 1
- if {[catch {r bitcount foo 0 4294967296} e]} {
- assert_match {*ERR*out of range*} $e
- set _ 1
- } else {
- set e
- }
- } {1}
- test {BITCOUNT misaligned prefix} {
- r del str
- r set str ab
- r bitcount str 1 -1
- } {3}
- test {BITCOUNT misaligned prefix + full words + remainder} {
- r del str
- r set str __PPxxxxxxxxxxxxxxxxRR__
- r bitcount str 2 -3
- } {74}
- test {BITOP NOT (empty string)} {
- r set s{t} ""
- r bitop not dest{t} s{t}
- r get dest{t}
- } {}
- test {BITOP NOT (known string)} {
- r set s{t} "\xaa\x00\xff\x55"
- r bitop not dest{t} s{t}
- r get dest{t}
- } "\x55\xff\x00\xaa"
- test {BITOP where dest and target are the same key} {
- r set s "\xaa\x00\xff\x55"
- r bitop not s s
- r get s
- } "\x55\xff\x00\xaa"
- test {BITOP AND|OR|XOR don't change the string with single input key} {
- r set a{t} "\x01\x02\xff"
- r bitop and res1{t} a{t}
- r bitop or res2{t} a{t}
- r bitop xor res3{t} a{t}
- list [r get res1{t}] [r get res2{t}] [r get res3{t}]
- } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"]
- test {BITOP missing key is considered a stream of zero} {
- r set a{t} "\x01\x02\xff"
- r bitop and res1{t} no-suck-key{t} a{t}
- r bitop or res2{t} no-suck-key{t} a{t} no-such-key{t}
- r bitop xor res3{t} no-such-key{t} a{t}
- list [r get res1{t}] [r get res2{t}] [r get res3{t}]
- } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"]
- test {BITOP shorter keys are zero-padded to the key with max length} {
- r set a{t} "\x01\x02\xff\xff"
- r set b{t} "\x01\x02\xff"
- r bitop and res1{t} a{t} b{t}
- r bitop or res2{t} a{t} b{t}
- r bitop xor res3{t} a{t} b{t}
- list [r get res1{t}] [r get res2{t}] [r get res3{t}]
- } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"]
- foreach op {and or xor} {
- test "BITOP $op fuzzing" {
- for {set i 0} {$i < 10} {incr i} {
- r flushall
- set vec {}
- set veckeys {}
- set numvec [expr {[randomInt 10]+1}]
- for {set j 0} {$j < $numvec} {incr j} {
- set str [randstring 0 1000]
- lappend vec $str
- lappend veckeys vector_$j{t}
- r set vector_$j{t} $str
- }
- r bitop $op target{t} {*}$veckeys
- assert_equal [r get target{t}] [simulate_bit_op $op {*}$vec]
- }
- }
- }
- test {BITOP NOT fuzzing} {
- for {set i 0} {$i < 10} {incr i} {
- r flushall
- set str [randstring 0 1000]
- r set str{t} $str
- r bitop not target{t} str{t}
- assert_equal [r get target{t}] [simulate_bit_op not $str]
- }
- }
- test {BITOP with integer encoded source objects} {
- r set a{t} 1
- r set b{t} 2
- r bitop xor dest{t} a{t} b{t} a{t}
- r get dest{t}
- } {2}
- test {BITOP with non string source key} {
- r del c{t}
- r set a{t} 1
- r set b{t} 2
- r lpush c{t} foo
- catch {r bitop xor dest{t} a{t} b{t} c{t} d{t}} e
- set e
- } {WRONGTYPE*}
- test {BITOP with empty string after non empty string (issue #529)} {
- r flushdb
- r set a{t} "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
- r bitop or x{t} a{t} b{t}
- } {32}
- test {BITPOS bit=0 with empty key returns 0} {
- r del str
- r bitpos str 0
- } {0}
- test {BITPOS bit=1 with empty key returns -1} {
- r del str
- r bitpos str 1
- } {-1}
- test {BITPOS bit=0 with string less than 1 word works} {
- r set str "\xff\xf0\x00"
- r bitpos str 0
- } {12}
- test {BITPOS bit=1 with string less than 1 word works} {
- r set str "\x00\x0f\x00"
- r bitpos str 1
- } {12}
- test {BITPOS bit=0 starting at unaligned address} {
- r set str "\xff\xf0\x00"
- r bitpos str 0 1
- } {12}
- test {BITPOS bit=1 starting at unaligned address} {
- r set str "\x00\x0f\xff"
- r bitpos str 1 1
- } {12}
- test {BITPOS bit=0 unaligned+full word+reminder} {
- r del str
- r set str "\xff\xff\xff" ; # Prefix
- # Followed by two (or four in 32 bit systems) full words
- r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
- r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
- r append str "\xff\xff\xff\xff\xff\xff\xff\xff"
- # First zero bit.
- r append str "\x0f"
- assert {[r bitpos str 0] == 216}
- assert {[r bitpos str 0 1] == 216}
- assert {[r bitpos str 0 2] == 216}
- assert {[r bitpos str 0 3] == 216}
- assert {[r bitpos str 0 4] == 216}
- assert {[r bitpos str 0 5] == 216}
- assert {[r bitpos str 0 6] == 216}
- assert {[r bitpos str 0 7] == 216}
- assert {[r bitpos str 0 8] == 216}
- }
- test {BITPOS bit=1 unaligned+full word+reminder} {
- r del str
- r set str "\x00\x00\x00" ; # Prefix
- # Followed by two (or four in 32 bit systems) full words
- r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
- r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
- r append str "\x00\x00\x00\x00\x00\x00\x00\x00"
- # First zero bit.
- r append str "\xf0"
- assert {[r bitpos str 1] == 216}
- assert {[r bitpos str 1 1] == 216}
- assert {[r bitpos str 1 2] == 216}
- assert {[r bitpos str 1 3] == 216}
- assert {[r bitpos str 1 4] == 216}
- assert {[r bitpos str 1 5] == 216}
- assert {[r bitpos str 1 6] == 216}
- assert {[r bitpos str 1 7] == 216}
- assert {[r bitpos str 1 8] == 216}
- }
- test {BITPOS bit=1 returns -1 if string is all 0 bits} {
- r set str ""
- for {set j 0} {$j < 20} {incr j} {
- assert {[r bitpos str 1] == -1}
- r append str "\x00"
- }
- }
- test {BITPOS bit=0 works with intervals} {
- r set str "\x00\xff\x00"
- assert {[r bitpos str 0 0 -1] == 0}
- assert {[r bitpos str 0 1 -1] == 16}
- assert {[r bitpos str 0 2 -1] == 16}
- assert {[r bitpos str 0 2 200] == 16}
- assert {[r bitpos str 0 1 1] == -1}
- }
- test {BITPOS bit=1 works with intervals} {
- r set str "\x00\xff\x00"
- assert {[r bitpos str 1 0 -1] == 8}
- assert {[r bitpos str 1 1 -1] == 8}
- assert {[r bitpos str 1 2 -1] == -1}
- assert {[r bitpos str 1 2 200] == -1}
- assert {[r bitpos str 1 1 1] == 8}
- }
- test {BITPOS bit=0 changes behavior if end is given} {
- r set str "\xff\xff\xff"
- assert {[r bitpos str 0] == 24}
- assert {[r bitpos str 0 0] == 24}
- assert {[r bitpos str 0 0 -1] == -1}
- }
- test {SETBIT/BITFIELD only increase dirty when the value changed} {
- r del foo{t} foo2{t} foo3{t}
- set dirty [s rdb_changes_since_last_save]
- # Create a new key, always increase the dirty.
- r setbit foo{t} 0 0
- r bitfield foo2{t} set i5 0 0
- set dirty2 [s rdb_changes_since_last_save]
- assert {$dirty2 == $dirty + 2}
- # No change.
- r setbit foo{t} 0 0
- r bitfield foo2{t} set i5 0 0
- set dirty3 [s rdb_changes_since_last_save]
- assert {$dirty3 == $dirty2}
- # Do a change and a no change.
- r setbit foo{t} 0 1
- r setbit foo{t} 0 1
- r setbit foo{t} 0 0
- r setbit foo{t} 0 0
- r bitfield foo2{t} set i5 0 1
- r bitfield foo2{t} set i5 0 1
- r bitfield foo2{t} set i5 0 0
- r bitfield foo2{t} set i5 0 0
- set dirty4 [s rdb_changes_since_last_save]
- assert {$dirty4 == $dirty3 + 4}
- # BITFIELD INCRBY always increase dirty.
- r bitfield foo3{t} incrby i5 0 1
- r bitfield foo3{t} incrby i5 0 1
- set dirty5 [s rdb_changes_since_last_save]
- assert {$dirty5 == $dirty4 + 2}
- }
- test {BITPOS bit=1 fuzzy testing using SETBIT} {
- r del str
- set max 524288; # 64k
- set first_one_pos -1
- for {set j 0} {$j < 1000} {incr j} {
- assert {[r bitpos str 1] == $first_one_pos}
- set pos [randomInt $max]
- r setbit str $pos 1
- if {$first_one_pos == -1 || $first_one_pos > $pos} {
- # Update the position of the first 1 bit in the array
- # if the bit we set is on the left of the previous one.
- set first_one_pos $pos
- }
- }
- }
- test {BITPOS bit=0 fuzzy testing using SETBIT} {
- set max 524288; # 64k
- set first_zero_pos $max
- r set str [string repeat "\xff" [expr $max/8]]
- for {set j 0} {$j < 1000} {incr j} {
- assert {[r bitpos str 0] == $first_zero_pos}
- set pos [randomInt $max]
- r setbit str $pos 0
- if {$first_zero_pos > $pos} {
- # Update the position of the first 0 bit in the array
- # if the bit we clear is on the left of the previous one.
- set first_zero_pos $pos
- }
- }
- }
- test "BIT pos larger than UINT_MAX" {
- set bytes [expr (1 << 29) + 1]
- set bitpos [expr (1 << 32)]
- set oldval [lindex [r config get proto-max-bulk-len] 1]
- r config set proto-max-bulk-len $bytes
- r setbit mykey $bitpos 1
- assert_equal $bytes [r strlen mykey]
- assert_equal 1 [r getbit mykey $bitpos]
- assert_equal [list 128 128 -1] [r bitfield mykey get u8 $bitpos set u8 $bitpos 255 get i8 $bitpos]
- assert_equal $bitpos [r bitpos mykey 1]
- assert_equal $bitpos [r bitpos mykey 1 [expr $bytes - 1]]
- if {$::accurate} {
- # set all bits to 1
- set mega [expr (1 << 23)]
- set part [string repeat "\xFF" $mega]
- for {set i 0} {$i < 64} {incr i} {
- r setrange mykey [expr $i * $mega] $part
- }
- r setrange mykey [expr $bytes - 1] "\xFF"
- assert_equal [expr $bitpos + 8] [r bitcount mykey]
- assert_equal -1 [r bitpos mykey 0 0 [expr $bytes - 1]]
- }
- r config set proto-max-bulk-len $oldval
- r del mykey
- } {1} {large-memory}
- }
|