summaryrefslogtreecommitdiff
path: root/tests/unit/bitops.tcl
blob: 5945d32d710c5024e89cc189e665f06734fbeb6e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
# 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]
        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

    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} {
        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 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 str
        r setbit foo 0 1
        r bitcount foo 0 4294967296
    } {1}

    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" {
            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
                    r set vector_$j $str
                }
                r bitop $op target {*}$veckeys
                assert_equal [r get target] [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 $str
            r bitop not target str
            assert_equal [r get target] [simulate_bit_op not $str]
        }
    }

    test {BITOP with integer encoded source objects} {
        r set a 1
        r set b 2
        r bitop xor dest a b a
        r get dest
    } {2}

    test {BITOP with non string source key} {
        r del c
        r set a 1
        r set b 2
        r lpush c foo
        catch {r bitop xor dest a b c d} e
        set e
    } {*ERR*}

    test {BITOP with empty string after non empty string (issue #529)} {
        r flushdb
        r set a "\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 a b
    } {32}
}