mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

Fix R6RS 'fixnum-width'.

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

* module/rnrs/arithmetic/fixnums.scm (fixnum-width): Rewrite to avoid
  inexact arithmetic, and correct the off-by-one error.

* test-suite/tests/r6rs-arithmetic-fixnums.test (fixnum-width): Add
  tests.
This commit is contained in:
Mark H Weaver 2013-07-16 17:38:14 -04:00
parent 1f4f2a12d0
commit 0690378621
2 changed files with 13 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -95,8 +95,11 @@
(rnrs exceptions (6))
(rnrs lists (6)))
(define fixnum-width
(let ((w (inexact->exact (round (/ (log (+ most-positive-fixnum 1)) (log 2))))))
(define fixnum-width
(let ((w (do ((i 0 (+ 1 i))
(n 1 (* 2 n)))
((> n most-positive-fixnum)
(+ 1 i)))))
(lambda () w)))
(define (greatest-fixnum) most-positive-fixnum)

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

@ -23,6 +23,14 @@
:use-module ((rnrs exceptions) :version (6))
:use-module (test-suite lib))
(with-test-prefix "fixnum-width"
(pass-if-equal "consistent with least-fixnum"
(- (expt 2 (- (fixnum-width) 1)))
(least-fixnum))
(pass-if-equal "consistent with greatest-fixnum"
(- (expt 2 (- (fixnum-width) 1)) 1)
(greatest-fixnum)))
(with-test-prefix "fixnum?"
(pass-if "fixnum? is #t for fixnums" (fixnum? 0))