1# Compare Redis commands against Tcl implementations of the same commands. 2proc count_bits s { 3 binary scan $s b* bits 4 string length [regsub -all {0} $bits {}] 5} 6 7proc 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 if {$op eq {not}} {set bit [expr {!$bit}]} 28 for {set j 1} {$j < $count} {incr j} { 29 set bit2 [string range $b($j) $x $x] 30 switch $op { 31 and {set bit [expr {$bit & $bit2}]} 32 or {set bit [expr {$bit | $bit2}]} 33 xor {set bit [expr {$bit ^ $bit2}]} 34 } 35 } 36 append out $bit 37 } 38 binary format b* $out 39} 40 41start_server {tags {"bitops"}} { 42 test {BITCOUNT returns 0 against non existing key} { 43 r bitcount no-key 44 } 0 45 46 test {BITCOUNT returns 0 with out of range indexes} { 47 r set str "xxxx" 48 r bitcount str 4 10 49 } 0 50 51 test {BITCOUNT returns 0 with negative indexes where start > end} { 52 r set str "xxxx" 53 r bitcount str -6 -7 54 } 0 55 56 catch {unset num} 57 foreach vec [list "" "\xaa" "\x00\x00\xff" "foobar" "123"] { 58 incr num 59 test "BITCOUNT against test vector #$num" { 60 r set str $vec 61 assert {[r bitcount str] == [count_bits $vec]} 62 } 63 } 64 65 test {BITCOUNT fuzzing without start/end} { 66 for {set j 0} {$j < 100} {incr j} { 67 set str [randstring 0 3000] 68 r set str $str 69 assert {[r bitcount str] == [count_bits $str]} 70 } 71 } 72 73 test {BITCOUNT fuzzing with start/end} { 74 for {set j 0} {$j < 100} {incr j} { 75 set str [randstring 0 3000] 76 r set str $str 77 set l [string length $str] 78 set start [randomInt $l] 79 set end [randomInt $l] 80 if {$start > $end} { 81 lassign [list $end $start] start end 82 } 83 assert {[r bitcount str $start $end] == [count_bits [string range $str $start $end]]} 84 } 85 } 86 87 test {BITCOUNT with start, end} { 88 r set s "foobar" 89 assert_equal [r bitcount s 0 -1] [count_bits "foobar"] 90 assert_equal [r bitcount s 1 -2] [count_bits "ooba"] 91 assert_equal [r bitcount s -2 1] [count_bits ""] 92 assert_equal [r bitcount s 0 1000] [count_bits "foobar"] 93 } 94 95 test {BITCOUNT syntax error #1} { 96 catch {r bitcount s 0} e 97 set e 98 } {ERR*syntax*} 99 100 test {BITCOUNT regression test for github issue #582} { 101 r del foo 102 r setbit foo 0 1 103 if {[catch {r bitcount foo 0 4294967296} e]} { 104 assert_match {*ERR*out of range*} $e 105 set _ 1 106 } else { 107 set e 108 } 109 } {1} 110 111 test {BITCOUNT misaligned prefix} { 112 r del str 113 r set str ab 114 r bitcount str 1 -1 115 } {3} 116 117 test {BITCOUNT misaligned prefix + full words + remainder} { 118 r del str 119 r set str __PPxxxxxxxxxxxxxxxxRR__ 120 r bitcount str 2 -3 121 } {74} 122 123 test {BITOP NOT (empty string)} { 124 r set s "" 125 r bitop not dest s 126 r get dest 127 } {} 128 129 test {BITOP NOT (known string)} { 130 r set s "\xaa\x00\xff\x55" 131 r bitop not dest s 132 r get dest 133 } "\x55\xff\x00\xaa" 134 135 test {BITOP where dest and target are the same key} { 136 r set s "\xaa\x00\xff\x55" 137 r bitop not s s 138 r get s 139 } "\x55\xff\x00\xaa" 140 141 test {BITOP AND|OR|XOR don't change the string with single input key} { 142 r set a "\x01\x02\xff" 143 r bitop and res1 a 144 r bitop or res2 a 145 r bitop xor res3 a 146 list [r get res1] [r get res2] [r get res3] 147 } [list "\x01\x02\xff" "\x01\x02\xff" "\x01\x02\xff"] 148 149 test {BITOP missing key is considered a stream of zero} { 150 r set a "\x01\x02\xff" 151 r bitop and res1 no-suck-key a 152 r bitop or res2 no-suck-key a no-such-key 153 r bitop xor res3 no-such-key a 154 list [r get res1] [r get res2] [r get res3] 155 } [list "\x00\x00\x00" "\x01\x02\xff" "\x01\x02\xff"] 156 157 test {BITOP shorter keys are zero-padded to the key with max length} { 158 r set a "\x01\x02\xff\xff" 159 r set b "\x01\x02\xff" 160 r bitop and res1 a b 161 r bitop or res2 a b 162 r bitop xor res3 a b 163 list [r get res1] [r get res2] [r get res3] 164 } [list "\x01\x02\xff\x00" "\x01\x02\xff\xff" "\x00\x00\x00\xff"] 165 166 foreach op {and or xor} { 167 test "BITOP $op fuzzing" { 168 for {set i 0} {$i < 10} {incr i} { 169 r flushall 170 set vec {} 171 set veckeys {} 172 set numvec [expr {[randomInt 10]+1}] 173 for {set j 0} {$j < $numvec} {incr j} { 174 set str [randstring 0 1000] 175 lappend vec $str 176 lappend veckeys vector_$j 177 r set vector_$j $str 178 } 179 r bitop $op target {*}$veckeys 180 assert_equal [r get target] [simulate_bit_op $op {*}$vec] 181 } 182 } 183 } 184 185 test {BITOP NOT fuzzing} { 186 for {set i 0} {$i < 10} {incr i} { 187 r flushall 188 set str [randstring 0 1000] 189 r set str $str 190 r bitop not target str 191 assert_equal [r get target] [simulate_bit_op not $str] 192 } 193 } 194 195 test {BITOP with integer encoded source objects} { 196 r set a 1 197 r set b 2 198 r bitop xor dest a b a 199 r get dest 200 } {2} 201 202 test {BITOP with non string source key} { 203 r del c 204 r set a 1 205 r set b 2 206 r lpush c foo 207 catch {r bitop xor dest a b c d} e 208 set e 209 } {WRONGTYPE*} 210 211 test {BITOP with empty string after non empty string (issue #529)} { 212 r flushdb 213 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" 214 r bitop or x a b 215 } {32} 216 217 test {BITPOS bit=0 with empty key returns 0} { 218 r del str 219 r bitpos str 0 220 } {0} 221 222 test {BITPOS bit=1 with empty key returns -1} { 223 r del str 224 r bitpos str 1 225 } {-1} 226 227 test {BITPOS bit=0 with string less than 1 word works} { 228 r set str "\xff\xf0\x00" 229 r bitpos str 0 230 } {12} 231 232 test {BITPOS bit=1 with string less than 1 word works} { 233 r set str "\x00\x0f\x00" 234 r bitpos str 1 235 } {12} 236 237 test {BITPOS bit=0 starting at unaligned address} { 238 r set str "\xff\xf0\x00" 239 r bitpos str 0 1 240 } {12} 241 242 test {BITPOS bit=1 starting at unaligned address} { 243 r set str "\x00\x0f\xff" 244 r bitpos str 1 1 245 } {12} 246 247 test {BITPOS bit=0 unaligned+full word+reminder} { 248 r del str 249 r set str "\xff\xff\xff" ; # Prefix 250 # Followed by two (or four in 32 bit systems) full words 251 r append str "\xff\xff\xff\xff\xff\xff\xff\xff" 252 r append str "\xff\xff\xff\xff\xff\xff\xff\xff" 253 r append str "\xff\xff\xff\xff\xff\xff\xff\xff" 254 # First zero bit. 255 r append str "\x0f" 256 assert {[r bitpos str 0] == 216} 257 assert {[r bitpos str 0 1] == 216} 258 assert {[r bitpos str 0 2] == 216} 259 assert {[r bitpos str 0 3] == 216} 260 assert {[r bitpos str 0 4] == 216} 261 assert {[r bitpos str 0 5] == 216} 262 assert {[r bitpos str 0 6] == 216} 263 assert {[r bitpos str 0 7] == 216} 264 assert {[r bitpos str 0 8] == 216} 265 } 266 267 test {BITPOS bit=1 unaligned+full word+reminder} { 268 r del str 269 r set str "\x00\x00\x00" ; # Prefix 270 # Followed by two (or four in 32 bit systems) full words 271 r append str "\x00\x00\x00\x00\x00\x00\x00\x00" 272 r append str "\x00\x00\x00\x00\x00\x00\x00\x00" 273 r append str "\x00\x00\x00\x00\x00\x00\x00\x00" 274 # First zero bit. 275 r append str "\xf0" 276 assert {[r bitpos str 1] == 216} 277 assert {[r bitpos str 1 1] == 216} 278 assert {[r bitpos str 1 2] == 216} 279 assert {[r bitpos str 1 3] == 216} 280 assert {[r bitpos str 1 4] == 216} 281 assert {[r bitpos str 1 5] == 216} 282 assert {[r bitpos str 1 6] == 216} 283 assert {[r bitpos str 1 7] == 216} 284 assert {[r bitpos str 1 8] == 216} 285 } 286 287 test {BITPOS bit=1 returns -1 if string is all 0 bits} { 288 r set str "" 289 for {set j 0} {$j < 20} {incr j} { 290 assert {[r bitpos str 1] == -1} 291 r append str "\x00" 292 } 293 } 294 295 test {BITPOS bit=0 works with intervals} { 296 r set str "\x00\xff\x00" 297 assert {[r bitpos str 0 0 -1] == 0} 298 assert {[r bitpos str 0 1 -1] == 16} 299 assert {[r bitpos str 0 2 -1] == 16} 300 assert {[r bitpos str 0 2 200] == 16} 301 assert {[r bitpos str 0 1 1] == -1} 302 } 303 304 test {BITPOS bit=1 works with intervals} { 305 r set str "\x00\xff\x00" 306 assert {[r bitpos str 1 0 -1] == 8} 307 assert {[r bitpos str 1 1 -1] == 8} 308 assert {[r bitpos str 1 2 -1] == -1} 309 assert {[r bitpos str 1 2 200] == -1} 310 assert {[r bitpos str 1 1 1] == 8} 311 } 312 313 test {BITPOS bit=0 changes behavior if end is given} { 314 r set str "\xff\xff\xff" 315 assert {[r bitpos str 0] == 24} 316 assert {[r bitpos str 0 0] == 24} 317 assert {[r bitpos str 0 0 -1] == -1} 318 } 319 320 test {BITPOS bit=1 fuzzy testing using SETBIT} { 321 r del str 322 set max 524288; # 64k 323 set first_one_pos -1 324 for {set j 0} {$j < 1000} {incr j} { 325 assert {[r bitpos str 1] == $first_one_pos} 326 set pos [randomInt $max] 327 r setbit str $pos 1 328 if {$first_one_pos == -1 || $first_one_pos > $pos} { 329 # Update the position of the first 1 bit in the array 330 # if the bit we set is on the left of the previous one. 331 set first_one_pos $pos 332 } 333 } 334 } 335 336 test {BITPOS bit=0 fuzzy testing using SETBIT} { 337 set max 524288; # 64k 338 set first_zero_pos $max 339 r set str [string repeat "\xff" [expr $max/8]] 340 for {set j 0} {$j < 1000} {incr j} { 341 assert {[r bitpos str 0] == $first_zero_pos} 342 set pos [randomInt $max] 343 r setbit str $pos 0 344 if {$first_zero_pos > $pos} { 345 # Update the position of the first 0 bit in the array 346 # if the bit we clear is on the left of the previous one. 347 set first_zero_pos $pos 348 } 349 } 350 } 351} 352