mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-28 05:50:30 +02:00
Code Activity

Fix 'fxbit-count' for negative arguments.

Browse source 
Reported by Göran Weinholt <goran@weinholt.se>.

* module/rnrs/arithmetic/fixnums.scm (fxbit-count): If the argument is
  negative, return the 'bitwise-not' of the result of 'logcount', as per
  R6RS.  Previously, 'fxbit-count' was identical to 'logcount'.

* test-suite/tests/r6rs-arithmetic-fixnums.test (fxbit-count): Add test.
This commit is contained in:
Mark H Weaver 2013-07-16 12:06:45 -04:00
parent 3bbca1f723
commit a1c9ecf0a4
2 changed files with 11 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/rnrs/arithmetic/fixnums.scm
View file

@ -1,6 +1,6 @@
;;; fixnums.scm --- The R6RS fixnums arithmetic library ;;; fixnums.scm --- The R6RS fixnums arithmetic library
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -227,7 +227,12 @@
(assert-fixnum fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3)
(bitwise-if fx1 fx2 fx3)) (bitwise-if fx1 fx2 fx3))
(define (fxbit-count fx) (assert-fixnum fx) (logcount fx)) (define (fxbit-count fx)
(assert-fixnum fx)
(if (negative? fx)
(bitwise-not (logcount fx))
(logcount fx)))
(define (fxlength fx) (assert-fixnum fx) (bitwise-length fx)) (define (fxlength fx) (assert-fixnum fx) (bitwise-length fx))
(define (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx)) (define (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx))
(define (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1)) (define (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1))

6
test-suite/tests/r6rs-arithmetic-fixnums.test
View file

@ -1,6 +1,6 @@
;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise) ;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise)
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -157,7 +157,9 @@
(with-test-prefix "fxif" (pass-if "simple" (fx=? (fxif 5 3 4) 1))) (with-test-prefix "fxif" (pass-if "simple" (fx=? (fxif 5 3 4) 1)))
(with-test-prefix "fxbit-count" (pass-if "simple" (fx=? (fxbit-count 5) 2))) (with-test-prefix "fxbit-count"
(pass-if "simple" (fx=? (fxbit-count 5) 2))
(pass-if "negative" (fx=? (fxbit-count -5) -2)))
(with-test-prefix "fxlength" (pass-if "simple" (fx=? (fxlength 5) 3))) (with-test-prefix "fxlength" (pass-if "simple" (fx=? (fxlength 5) 3)))