tests/unit/bitops.tcl

   1 # Compare Redis commadns against Tcl implementations of the same commands.
   2 proc count_bits s {
   3     binary scan $s b* bits
   4     string length [regsub -all {0} $bits {}]
   5 }
   6
   7 proc simulate_bit_op {op args} {
   8     set maxlen 0
   9     set j 0
  10     set count [llength $args]
  11     foreach a $args {
  12         binary scan $a b* bits
  13         set b($j) $bits
  14         if {[string length $bits] > $maxlen} {
  15             set maxlen [string length $bits]
  16         }
  17         incr j
  18     }
  19     for {set j 0} {$j < $count} {incr j} {
  20         if {[string length $b($j)] < $maxlen} {
  21             append b($j) [string repeat 0 [expr $maxlen-[string length $b($j)]]]
  22         }
  23     }
  24     set out {}
  25     for {set x 0} {$x < $maxlen} {incr x} {
  26         set bit [string range $b(0) $x $x]
  27         for {set j 1} {$j < $count} {incr j} {
  28             set bit2 [string range $b($j) $x $x]
  29             switch $op {
  30                 and {set bit [expr {$bit & $bit2}]}
  31                 or  {set bit [expr {$bit | $bit2}]}
  32                 xor {set bit [expr {$bit ^ $bit2}]}
  33                 not {set bit [expr {!$bit}]}
  34             }
  35         }
  36         append out $bit
  37     }
  38     binary format b* $out
  39 }
  40
  41 start_server {tags {"bitops"}} {
  42     test {BITCOUNT returns 0 against non existing key} {
  43         r bitcount no-key
  44     } 0
  45
  46     catch {unset num}
  47     foreach vec [list \
  48         "" "\xaa" "\x00\x00\xff" "foobar" \
  49         [randstring 2000 3000] [randstring 2000 3000] \
  50         [randstring 2000 3000] \
  51     ] {
  52         incr num
  53         test "BITCOUNT against test vector #$num" {
  54             r set str $vec
  55             assert {[r bitcount str] == [count_bits $vec]}
  56         }
  57     }
  58
  59     test {BITCOUNT with start, end} {
  60         r set s "foobar"
  61         assert_equal [r bitcount s 0 -1] [count_bits "foobar"]
  62         assert_equal [r bitcount s 1 -2] [count_bits "ooba"]
  63         assert_equal [r bitcount s -2 1] [count_bits ""]
  64         assert_equal [r bitcount s 0 1000] [count_bits "foobar"]
  65     }
  66
  67     test {BITCOUNT syntax error #1} {
  68         catch {r bitcount s 0} e
  69         set e
  70     } {ERR*syntax*}
  71
  72     test {BITOP NOT (empty string)} {
  73         r set s ""
  74         r bitop not dest s
  75         r get dest
  76     } {}
  77
  78     test {BITOP NOT (known string)} {
  79         r set s "\xaa\x00\xff\x55"
  80         r bitop not dest s
  81         r get dest
  82     } "\x55\xff\x00\xaa"
  83
  84     test {BITOP where dest and target are the same key} {
  85         r set s "\xaa\x00\xff\x55"
  86         r bitop not s s
  87         r get s
  88     } "\x55\xff\x00\xaa"
  89
  90     test {BITOP AND|OR|XOR don't change the string with single input key} {
  91         r set a "\x01\x02\xff"
  92         r bitop and res1 a
  93         r bitop or  res2 a
  94         r bitop xor res3 a
  95         list [r get res1] [r get res2] [r get res3]
  96     } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"]
  97
  98     test {BITOP missing key is considered a stream of zero} {
  99         r set a "\x01\x02\xff"
 100         r bitop and res1 no-suck-key a
 101         r bitop or  res2 no-suck-key a no-such-key
 102         r bitop xor res3 no-such-key a
 103         list [r get res1] [r get res2] [r get res3]
 104     } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"]
 105
 106     test {BITOP shorter keys are zero-padded to the key with max length} {
 107         r set a "\x01\x02\xff\xff"
 108         r set b "\x01\x02\xff"
 109         r bitop and res1 a b
 110         r bitop or  res2 a b
 111         r bitop xor res3 a b
 112         list [r get res1] [r get res2] [r get res3]
 113     } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"]
 114
 115     foreach op {and or xor} {
 116         test "BITOP $op fuzzing" {
 117             set vec {}
 118             set veckeys {}
 119             set numvec [expr {[randomInt 10]+1}]
 120             for {set j 0} {$j < $numvec} {incr j} {
 121                 set str [randstring 0 1000]
 122                 lappend vec $str
 123                 lappend veckeys vector_$j
 124                 r set vector_$j $str
 125             }
 126             r bitop $op target {*}$veckeys
 127             assert_equal [r get target] [simulate_bit_op $op {*}$vec]
 128         }
 129     }
 130 }