1 # Compare Redis commadns against Tcl implementations of the same commands.
4 string length
[regsub -all {0} $bits {}]
7 proc simulate_bit_op
{op args
} {
10 set count
[llength $args]
12 binary scan $a b
* bits
14 if {[string length
$bits] > $maxlen} {
15 set maxlen
[string length
$bits]
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)]]]
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]
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}]}
41 start_server
{tags
{"bitops"}} {
42 test
{BITCOUNT returns
0 against non existing key
} {
47 foreach vec
[list "" "\xaa" "\x00\x00\xff" "foobar"] {
49 test
"BITCOUNT against test vector #$num" {
51 assert
{[r bitcount str
] == [count_bits
$vec]}
55 test
{BITCOUNT fuzzing
} {
56 for {set j
0} {$j < 100} {incr j
} {
57 set str
[randstring
0 3000]
59 assert
{[r bitcount str
] == [count_bits
$str]}
63 test
{BITCOUNT with start
, end
} {
65 assert_equal
[r bitcount s
0 -1] [count_bits
"foobar"]
66 assert_equal
[r bitcount s
1 -2] [count_bits
"ooba"]
67 assert_equal
[r bitcount s
-2 1] [count_bits
""]
68 assert_equal
[r bitcount s
0 1000] [count_bits
"foobar"]
71 test
{BITCOUNT syntax
error #1} {
72 catch {r bitcount s
0} e
76 test
{BITOP NOT
(empty
string)} {
82 test
{BITOP NOT
(known
string)} {
83 r
set s
"\xaa\x00\xff\x55"
88 test
{BITOP where dest and target are the same key
} {
89 r
set s
"\xaa\x00\xff\x55"
94 test
{BITOP AND|OR|XOR don't change the
string with single input key
} {
95 r
set a
"\x01\x02\xff"
99 list [r get res1
] [r get res2
] [r get res3
]
100 } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"]
102 test
{BITOP missing key is considered a stream of zero
} {
103 r
set a
"\x01\x02\xff"
104 r bitop and res1 no-suck-key a
105 r bitop or res2 no-suck-key a no-such-key
106 r bitop xor res3 no-such-key a
107 list [r get res1
] [r get res2
] [r get res3
]
108 } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"]
110 test
{BITOP shorter keys are zero-padded to the key with max length
} {
111 r
set a
"\x01\x02\xff\xff"
112 r
set b
"\x01\x02\xff"
116 list [r get res1
] [r get res2
] [r get res3
]
117 } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"]
119 foreach op
{and or xor
} {
120 test
"BITOP $op fuzzing" {
121 for {set i
0} {$i < 10} {incr i
} {
124 set numvec
[expr {[randomInt
10]+1}]
125 for {set j
0} {$j < $numvec} {incr j
} {
126 set str
[randstring
0 1000]
128 lappend veckeys vector_
$j
131 r bitop
$op target
{*}$veckeys
132 assert_equal
[r get target
] [simulate_bit_op
$op {*}$vec]