mirror of
http://github.com/valkey-io/valkey
synced 2024-11-23 03:33:28 +00:00
a3f2b4895b
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.
131 lines
3.9 KiB
Tcl
131 lines
3.9 KiB
Tcl
# 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]
|
|
}
|
|
}
|
|
}
|