From 06903786211afd9a554b8f009a37111f729607ee Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 16 Jul 2013 17:38:14 -0400 Subject: [PATCH] Fix R6RS 'fixnum-width'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Göran Weinholt . * 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. --- module/rnrs/arithmetic/fixnums.scm | 7 +++++-- test-suite/tests/r6rs-arithmetic-fixnums.test | 8 ++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index dbf9ee746..7a5a6215e 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -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) diff --git a/test-suite/tests/r6rs-arithmetic-fixnums.test b/test-suite/tests/r6rs-arithmetic-fixnums.test index 01a7a89b2..60c3b87e9 100644 --- a/test-suite/tests/r6rs-arithmetic-fixnums.test +++ b/test-suite/tests/r6rs-arithmetic-fixnums.test @@ -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))