diff options
author | Mark H Weaver <mhw@netris.org> | 2013-03-03 04:58:55 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-03-12 15:39:25 -0400 |
commit | 1eb6a33a30ea27f97fc401a25a3014e10e3c6f98 (patch) | |
tree | f0facfa4d2fd29f403064ed70842e907ad2ef908 /test-suite/tests | |
parent | e08a12b5356c20ed0418bcaee136eb3632c5616f (diff) | |
download | guile-1eb6a33a30ea27f97fc401a25a3014e10e3c6f98.tar.gz |
Simplify and improve scm_i_big2dbl, and add scm_i_big2dbl_2exp
* libguile/numbers.c (scm_i_big2dbl_2exp): New static function.
(scm_i_big2dbl): Reimplement in terms of 'scm_i_big2dbl_2exp',
with proper rounding.
* test-suite/tests/numbers.test ("exact->inexact"): Add tests.
Diffstat (limited to 'test-suite/tests')
-rw-r--r-- | test-suite/tests/numbers.test | 57 |
1 files changed, 44 insertions, 13 deletions
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index bb1424853..6b4e08c3a 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -3858,21 +3858,17 @@ ;;; (with-test-prefix "exact->inexact" - + + ;; Test "(exact->inexact n)", expect "want". + (define (test name n want) + (with-test-prefix name + (pass-if-equal "pos" want (exact->inexact n)) + (pass-if-equal "neg" (- want) (exact->inexact (- n))))) + ;; Test "(exact->inexact n)", expect "want". ;; "i" is a index, for diagnostic purposes. (define (try-i i n want) - (with-test-prefix (list i n want) - (with-test-prefix "pos" - (let ((got (exact->inexact n))) - (pass-if "inexact?" (inexact? got)) - (pass-if (list "=" got) (= want got)))) - (set! n (- n)) - (set! want (- want)) - (with-test-prefix "neg" - (let ((got (exact->inexact n))) - (pass-if "inexact?" (inexact? got)) - (pass-if (list "=" got) (= want got)))))) + (test (list i n want) n want)) (with-test-prefix "2^i, no round" (do ((i 0 (1+ i)) @@ -3945,7 +3941,42 @@ ;; convert the num and den to doubles, resulting in infs. (pass-if "frac big/big, exceeding double" (let ((big (ash 1 4096))) - (= 1.0 (exact->inexact (/ (1+ big) big)))))) + (= 1.0 (exact->inexact (/ (1+ big) big))))) + + (test "round up to odd" + ;; ===================================================== + ;; 11111111111111111111111111111111111111111111111111000101 -> + ;; 11111111111111111111111111111111111111111111111111001000 + (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b000101) + (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000)) + + (test "round down to odd" + ;; ===================================================== + ;; 11111111111111111111111111111111111111111111111111001011 -> + ;; 11111111111111111111111111111111111111111111111111001000 + (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b001011) + (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b001000)) + + (test "round tie up to even" + ;; ===================================================== + ;; 11111111111111111111111111111111111111111111111111011100 -> + ;; 11111111111111111111111111111111111111111111111111100000 + (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b011100) + (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b100000)) + + (test "round tie down to even" + ;; ===================================================== + ;; 11111111111111111111111111111111111111111111111111000100 -> + ;; 11111111111111111111111111111111111111111111111111000000 + (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b000100) + (+ (expt 2.0 (+ dbl-mant-dig 3)) -64 #b000000)) + + (test "round tie up to next power of two" + ;; ===================================================== + ;; 11111111111111111111111111111111111111111111111111111100 -> + ;; 100000000000000000000000000000000000000000000000000000000 + (+ (expt 2 (+ dbl-mant-dig 3)) -64 #b111100) + (expt 2.0 (+ dbl-mant-dig 3)))) ;;; ;;; expt |