BITOP and BITCOUNT tests.

The Redis implementation is tested against Tcl implementations of the
same operation. Both fuzzing and testing of specific aspects of the
commands behavior are performed.

diff --git a/tests/test_helper.tcl b/tests/test_helper.tcl
index 7874256da64763037d5c2f1d54f17b1f88b11381..853193ccdc1f5349ded96703ef9ec5db8d9624e9 100644 (file)
--- a/tests/test_helper.tcl
+++ b/tests/test_helper.tcl
@@ -41,6 +41,7 @@ set ::all_tests {
     unit/limits
     unit/obuf-limits
     unit/dump
+    unit/bitops
 }
 # Index to the next test to run in the ::all_tests list.
 set ::next_test 0

diff --git a/tests/unit/bitops.tcl b/tests/unit/bitops.tcl
new file mode 100644 (file)
index 0000000..c072f54
--- /dev/null
+++ b/tests/unit/bitops.tcl
@@ -0,0 +1,130 @@
+# Compare Redis commadns 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]
+        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}]}
+                not {set bit [expr {!$bit}]}
+            }
+        }
+        append out $bit
+    }
+    binary format b* $out
+}
+
+start_server {tags {"bitops"}} {
+    test {BITCOUNT returns 0 against non existing key} {
+        r bitcount no-key
+    } 0
+
+    catch {unset num}
+    foreach vec [list \
+        "" "\xaa" "\x00\x00\xff" "foobar" \
+        [randstring 2000 3000] [randstring 2000 3000] \
+        [randstring 2000 3000] \
+    ] {
+        incr num
+        test "BITCOUNT against test vector #$num" {
+            r set str $vec
+            assert {[r bitcount str] == [count_bits $vec]}
+        }
+    }
+
+    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 {BITOP NOT (empty string)} {
+        r set s ""
+        r bitop not dest s
+        r get dest
+    } {}
+
+    test {BITOP NOT (known string)} {
+        r set s "\xaa\x00\xff\x55"
+        r bitop not dest s
+        r get dest
+    } "\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 "\x01\x02\xff"
+        r bitop and res1 a
+        r bitop or  res2 a
+        r bitop xor res3 a
+        list [r get res1] [r get res2] [r get res3]
+    } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"]
+
+    test {BITOP missing key is considered a stream of zero} {
+        r set a "\x01\x02\xff"
+        r bitop and res1 no-suck-key a
+        r bitop or  res2 no-suck-key a no-such-key
+        r bitop xor res3 no-such-key a
+        list [r get res1] [r get res2] [r get res3]
+    } [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 "\x01\x02\xff\xff"
+        r set b "\x01\x02\xff"
+        r bitop and res1 a b
+        r bitop or  res2 a b
+        r bitop xor res3 a b
+        list [r get res1] [r get res2] [r get res3]
+    } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"]
+
+    foreach op {and or xor} {
+        test "BITOP $op fuzzing" {
+            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
+                r set vector_$j $str
+            }
+            r bitop $op target {*}$veckeys
+            assert_equal [r get target] [simulate_bit_op $op {*}$vec]
+        }
+    }
+}