1start_server {tags {"bitops"}} { 2 test {BITFIELD signed SET and GET basics} { 3 r del bits 4 set results {} 5 lappend results [r bitfield bits set i8 0 -100] 6 lappend results [r bitfield bits set i8 0 101] 7 lappend results [r bitfield bits get i8 0] 8 set results 9 } {0 -100 101} 10 11 test {BITFIELD unsigned SET and GET basics} { 12 r del bits 13 set results {} 14 lappend results [r bitfield bits set u8 0 255] 15 lappend results [r bitfield bits set u8 0 100] 16 lappend results [r bitfield bits get u8 0] 17 set results 18 } {0 255 100} 19 20 test {BITFIELD #<idx> form} { 21 r del bits 22 set results {} 23 r bitfield bits set u8 #0 65 24 r bitfield bits set u8 #1 66 25 r bitfield bits set u8 #2 67 26 r get bits 27 } {ABC} 28 29 test {BITFIELD basic INCRBY form} { 30 r del bits 31 set results {} 32 r bitfield bits set u8 #0 10 33 lappend results [r bitfield bits incrby u8 #0 100] 34 lappend results [r bitfield bits incrby u8 #0 100] 35 set results 36 } {110 210} 37 38 test {BITFIELD chaining of multiple commands} { 39 r del bits 40 set results {} 41 r bitfield bits set u8 #0 10 42 lappend results [r bitfield bits incrby u8 #0 100 incrby u8 #0 100] 43 set results 44 } {{110 210}} 45 46 test {BITFIELD unsigned overflow wrap} { 47 r del bits 48 set results {} 49 r bitfield bits set u8 #0 100 50 lappend results [r bitfield bits overflow wrap incrby u8 #0 257] 51 lappend results [r bitfield bits get u8 #0] 52 lappend results [r bitfield bits overflow wrap incrby u8 #0 255] 53 lappend results [r bitfield bits get u8 #0] 54 } {101 101 100 100} 55 56 test {BITFIELD unsigned overflow sat} { 57 r del bits 58 set results {} 59 r bitfield bits set u8 #0 100 60 lappend results [r bitfield bits overflow sat incrby u8 #0 257] 61 lappend results [r bitfield bits get u8 #0] 62 lappend results [r bitfield bits overflow sat incrby u8 #0 -255] 63 lappend results [r bitfield bits get u8 #0] 64 } {255 255 0 0} 65 66 test {BITFIELD signed overflow wrap} { 67 r del bits 68 set results {} 69 r bitfield bits set i8 #0 100 70 lappend results [r bitfield bits overflow wrap incrby i8 #0 257] 71 lappend results [r bitfield bits get i8 #0] 72 lappend results [r bitfield bits overflow wrap incrby i8 #0 255] 73 lappend results [r bitfield bits get i8 #0] 74 } {101 101 100 100} 75 76 test {BITFIELD signed overflow sat} { 77 r del bits 78 set results {} 79 r bitfield bits set u8 #0 100 80 lappend results [r bitfield bits overflow sat incrby i8 #0 257] 81 lappend results [r bitfield bits get i8 #0] 82 lappend results [r bitfield bits overflow sat incrby i8 #0 -255] 83 lappend results [r bitfield bits get i8 #0] 84 } {127 127 -128 -128} 85 86 test {BITFIELD overflow detection fuzzing} { 87 for {set j 0} {$j < 1000} {incr j} { 88 set bits [expr {[randomInt 64]+1}] 89 set sign [randomInt 2] 90 set range [expr {2**$bits}] 91 if {$bits == 64} {set sign 1} ; # u64 is not supported by BITFIELD. 92 if {$sign} { 93 set min [expr {-($range/2)}] 94 set type "i$bits" 95 } else { 96 set min 0 97 set type "u$bits" 98 } 99 set max [expr {$min+$range-1}] 100 101 # Compare Tcl vs Redis 102 set range2 [expr {$range*2}] 103 set value [expr {($min*2)+[randomInt $range2]}] 104 set increment [expr {($min*2)+[randomInt $range2]}] 105 if {$value > 9223372036854775807} { 106 set value 9223372036854775807 107 } 108 if {$value < -9223372036854775808} { 109 set value -9223372036854775808 110 } 111 if {$increment > 9223372036854775807} { 112 set increment 9223372036854775807 113 } 114 if {$increment < -9223372036854775808} { 115 set increment -9223372036854775808 116 } 117 118 set overflow 0 119 if {$value > $max || $value < $min} {set overflow 1} 120 if {($value + $increment) > $max} {set overflow 1} 121 if {($value + $increment) < $min} {set overflow 1} 122 123 r del bits 124 set res1 [r bitfield bits overflow fail set $type 0 $value] 125 set res2 [r bitfield bits overflow fail incrby $type 0 $increment] 126 127 if {$overflow && [lindex $res1 0] ne {} && 128 [lindex $res2 0] ne {}} { 129 fail "OW not detected where needed: $type $value+$increment" 130 } 131 if {!$overflow && ([lindex $res1 0] eq {} || 132 [lindex $res2 0] eq {})} { 133 fail "OW detected where NOT needed: $type $value+$increment" 134 } 135 } 136 } 137 138 test {BITFIELD overflow wrap fuzzing} { 139 for {set j 0} {$j < 1000} {incr j} { 140 set bits [expr {[randomInt 64]+1}] 141 set sign [randomInt 2] 142 set range [expr {2**$bits}] 143 if {$bits == 64} {set sign 1} ; # u64 is not supported by BITFIELD. 144 if {$sign} { 145 set min [expr {-($range/2)}] 146 set type "i$bits" 147 } else { 148 set min 0 149 set type "u$bits" 150 } 151 set max [expr {$min+$range-1}] 152 153 # Compare Tcl vs Redis 154 set range2 [expr {$range*2}] 155 set value [expr {($min*2)+[randomInt $range2]}] 156 set increment [expr {($min*2)+[randomInt $range2]}] 157 if {$value > 9223372036854775807} { 158 set value 9223372036854775807 159 } 160 if {$value < -9223372036854775808} { 161 set value -9223372036854775808 162 } 163 if {$increment > 9223372036854775807} { 164 set increment 9223372036854775807 165 } 166 if {$increment < -9223372036854775808} { 167 set increment -9223372036854775808 168 } 169 170 r del bits 171 r bitfield bits overflow wrap set $type 0 $value 172 r bitfield bits overflow wrap incrby $type 0 $increment 173 set res [lindex [r bitfield bits get $type 0] 0] 174 175 set expected 0 176 if {$sign} {incr expected [expr {$max+1}]} 177 incr expected $value 178 incr expected $increment 179 set expected [expr {$expected % $range}] 180 if {$sign} {incr expected $min} 181 182 if {$res != $expected} { 183 fail "WRAP error: $type $value+$increment = $res, should be $expected" 184 } 185 } 186 } 187} 188