"Fossies" - the Fresh Open Source Software Archive

Member "redis-6.2.5/tests/unit/bitops.tcl" (21 Jul 2021, 12174 Bytes) of package /linux/misc/redis-6.2.5.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "bitops.tcl": 6.2.4_vs_6.2.5.

    1 # Compare Redis commands against Tcl implementations of the same commands.
    2 proc count_bits s {
    3     binary scan $s b* bits
    4     string length [regsub -all {0} $bits {}]
    5 }
    6 
    7 proc 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 
   41 start_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 
  353 start_server {tags {"bitops large-memory"}} {
  354     test "BIT pos larger than UINT_MAX" {
  355         set bytes [expr (1 << 29) + 1]
  356         set bitpos [expr (1 << 32)]
  357         set oldval [lindex [r config get proto-max-bulk-len] 1]
  358         r config set proto-max-bulk-len $bytes
  359         r setbit mykey $bitpos 1
  360         assert_equal $bytes [r strlen mykey]
  361         assert_equal 1 [r getbit mykey $bitpos]
  362         assert_equal [list 128 128 -1] [r bitfield mykey get u8 $bitpos set u8 $bitpos 255 get i8 $bitpos]
  363         assert_equal $bitpos [r bitpos mykey 1]
  364         assert_equal $bitpos [r bitpos mykey 1 [expr $bytes - 1]]
  365         if {$::accurate} {
  366             # set all bits to 1
  367             set mega [expr (1 << 23)]
  368             set part [string repeat "\xFF" $mega]
  369             for {set i 0} {$i < 64} {incr i} {
  370                 r setrange mykey [expr $i * $mega] $part
  371             }
  372             r setrange mykey [expr $bytes - 1] "\xFF"
  373             assert_equal [expr $bitpos + 8] [r bitcount mykey]
  374             assert_equal -1 [r bitpos mykey 0 0 [expr $bytes - 1]]
  375         }
  376         r config set proto-max-bulk-len $oldval
  377         r del mykey
  378     } {1}
  379 }