mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 13:00:34 +02:00
Code Activity

Fix 'bitwise-bit-count' for negative arguments.

Browse source 
Fixes <http://bugs.gnu.org/14864>.
Reported by Göran Weinholt <goran@weinholt.se>.

* module/rnrs/arithmetic/bitwise.scm (bitwise-bit-count): If the
  argument is negative, return the 'bitwise-not' of the result of
  'logcount', as per R6RS.  Previously, 'bitwise-bit-count' was
  identical to 'logcount'.
This commit is contained in:
Mark H Weaver 2013-07-14 14:08:33 -04:00
parent 10454601e0
commit e8f3299726
2 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/rnrs/arithmetic/bitwise.scm
View file

@ -53,9 +53,13 @@
(logand bitwise-and) (logand bitwise-and)
(logior bitwise-ior) (logior bitwise-ior)
(logxor bitwise-xor) (logxor bitwise-xor)
(logcount bitwise-bit-count)
(ash bitwise-arithmetic-shift))) (ash bitwise-arithmetic-shift)))
(define (bitwise-bit-count ei)
(if (negative? ei)
(bitwise-not (logcount ei))
(logcount ei)))
(define (bitwise-if ei1 ei2 ei3) (define (bitwise-if ei1 ei2 ei3)
(bitwise-ior (bitwise-and ei1 ei2) (bitwise-and (bitwise-not ei1) ei3))) (bitwise-ior (bitwise-and ei1 ei2) (bitwise-and (bitwise-not ei1) ei3)))

4
test-suite/tests/r6rs-arithmetic-bitwise.test
View file

@ -43,7 +43,9 @@
(with-test-prefix "bitwise-bit-count" (with-test-prefix "bitwise-bit-count"
(pass-if "bitwise-bit-count simple" (pass-if "bitwise-bit-count simple"
(eqv? (bitwise-bit-count #b101) 2))) (eqv? (bitwise-bit-count #b101) 2))
(pass-if "bitwise-bit-count negative"
(eqv? (bitwise-bit-count #b-101) -2)))
(with-test-prefix "bitwise-length" (with-test-prefix "bitwise-length"
(pass-if "bitwise-length simple" (pass-if "bitwise-length simple"