15 |
;;;; License along with this library; if not, write to the Free Software |
;;;; License along with this library; if not, write to the Free Software |
16 |
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
17 |
|
|
18 |
(use-modules (ice-9 documentation)) |
(define-module (test-suite test-numbers) |
19 |
|
#:use-module (test-suite lib) |
20 |
|
#:use-module (ice-9 documentation)) |
21 |
|
|
22 |
;;; |
;;; |
23 |
;;; miscellaneous |
;;; miscellaneous |
35 |
(define fixnum-min most-negative-fixnum) |
(define fixnum-min most-negative-fixnum) |
36 |
(define fixnum-max most-positive-fixnum) |
(define fixnum-max most-positive-fixnum) |
37 |
|
|
38 |
|
;; Divine the number of bits in the mantissa of a flonum. |
39 |
|
;; We look for when 2.0^i+1.0 gets rounded, ie. the difference between that |
40 |
|
;; value and 2.0^k is not 1.0. |
41 |
|
;; Of course this assumes flonums have a fixed precision mantissa, but |
42 |
|
;; that's the case now and probably into the forseeable future. |
43 |
|
;; On an IEEE system, which means pretty much everywhere, the value here is |
44 |
|
;; the usual 53. |
45 |
|
;; |
46 |
|
(define dbl-mant-dig |
47 |
|
(let more ((i 1) |
48 |
|
(d 2.0)) |
49 |
|
(if (> i 1024) |
50 |
|
(error "Oops, cannot determine number of bits in mantissa of inexact")) |
51 |
|
(let* ((sum (+ 1.0 d)) |
52 |
|
(diff (- sum d))) |
53 |
|
(if (= diff 1.0) |
54 |
|
(more (1+ i) (* 2.0 d)) |
55 |
|
i)))) |
56 |
|
|
57 |
|
;; like ash, but working on a flonum |
58 |
|
(define (ash-flo x n) |
59 |
|
(while (> n 0) |
60 |
|
(set! x (* 2.0 x)) |
61 |
|
(set! n (1- n))) |
62 |
|
(while (< n 0) |
63 |
|
(set! x (* 0.5 x)) |
64 |
|
(set! n (1+ n))) |
65 |
|
x) |
66 |
|
|
67 |
|
|
68 |
;;; |
;;; |
69 |
;;; exact? |
;;; exact? |
70 |
;;; |
;;; |
1997 |
;;; exact->inexact |
;;; exact->inexact |
1998 |
;;; |
;;; |
1999 |
|
|
2000 |
|
(with-test-prefix "exact->inexact" |
2001 |
|
|
2002 |
|
;; Test "(exact->inexact n)", expect "want". |
2003 |
|
;; "i" is a index, for diagnostic purposes. |
2004 |
|
(define (try-i i n want) |
2005 |
|
(with-test-prefix (list i n want) |
2006 |
|
(with-test-prefix "pos" |
2007 |
|
(let ((got (exact->inexact n))) |
2008 |
|
(pass-if "inexact?" (inexact? got)) |
2009 |
|
(pass-if (list "=" got) (= want got)))) |
2010 |
|
(set! n (- n)) |
2011 |
|
(set! want (- want)) |
2012 |
|
(with-test-prefix "neg" |
2013 |
|
(let ((got (exact->inexact n))) |
2014 |
|
(pass-if "inexact?" (inexact? got)) |
2015 |
|
(pass-if (list "=" got) (= want got)))))) |
2016 |
|
|
2017 |
|
(with-test-prefix "2^i, no round" |
2018 |
|
(do ((i 0 (1+ i)) |
2019 |
|
(n 1 (* 2 n)) |
2020 |
|
(want 1.0 (* 2.0 want))) |
2021 |
|
((> i 100)) |
2022 |
|
(try-i i n want))) |
2023 |
|
|
2024 |
|
(with-test-prefix "2^i+1, no round" |
2025 |
|
(do ((i 1 (1+ i)) |
2026 |
|
(n 3 (1- (* 2 n))) |
2027 |
|
(want 3.0 (- (* 2.0 want) 1.0))) |
2028 |
|
((>= i dbl-mant-dig)) |
2029 |
|
(try-i i n want))) |
2030 |
|
|
2031 |
|
(with-test-prefix "(2^i+1)*2^100, no round" |
2032 |
|
(do ((i 1 (1+ i)) |
2033 |
|
(n 3 (1- (* 2 n))) |
2034 |
|
(want 3.0 (- (* 2.0 want) 1.0))) |
2035 |
|
((>= i dbl-mant-dig)) |
2036 |
|
(try-i i (ash n 100) (ash-flo want 100)))) |
2037 |
|
|
2038 |
|
;; bit pattern: 1111....11100.00 |
2039 |
|
;; <-mantdig-><-i-> |
2040 |
|
;; |
2041 |
|
(with-test-prefix "mantdig ones then zeros, no rounding" |
2042 |
|
(do ((i 0 (1+ i)) |
2043 |
|
(n (- (ash 1 dbl-mant-dig) 1) (* 2 n)) |
2044 |
|
(want (- (ash-flo 1.0 dbl-mant-dig) 1.0) (* 2.0 want))) |
2045 |
|
((> i 100)) |
2046 |
|
(try-i i n want))) |
2047 |
|
|
2048 |
|
;; bit pattern: 1111....111011..1 |
2049 |
|
;; <-mantdig-> <-i-> |
2050 |
|
;; This sort of value was incorrectly rounded upwards in Guile 1.6.4 when |
2051 |
|
;; i >= 11 (that's when the total is 65 or more bits). |
2052 |
|
;; |
2053 |
|
(with-test-prefix "mantdig ones then 011..11, round down" |
2054 |
|
(do ((i 0 (1+ i)) |
2055 |
|
(n (- (ash 1 (+ 1 dbl-mant-dig)) 2) (+ 1 (* 2 n))) |
2056 |
|
(want (- (ash-flo 1.0 (+ 1 dbl-mant-dig)) 2.0) (* 2.0 want))) |
2057 |
|
((> i 100)) |
2058 |
|
(try-i i n want))) |
2059 |
|
|
2060 |
|
;; bit pattern: 1111....111100..001 |
2061 |
|
;; <-mantdig-> <--i-> |
2062 |
|
;; |
2063 |
|
(with-test-prefix "mantdig ones then 100..001, round up" |
2064 |
|
(do ((i 0 (1+ i)) |
2065 |
|
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n))) |
2066 |
|
(want (ash-flo 1.0 (+ 2 dbl-mant-dig)) (* 2.0 want))) |
2067 |
|
((> i 100)) |
2068 |
|
(try-i i n want))) |
2069 |
|
|
2070 |
|
;; bit pattern: 1000....000100..001 |
2071 |
|
;; <-mantdig-> <--i-> |
2072 |
|
;; |
2073 |
|
(with-test-prefix "2^mantdig then 100..001, round up" |
2074 |
|
(do ((i 0 (1+ i)) |
2075 |
|
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n))) |
2076 |
|
(want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want))) |
2077 |
|
((> i 100)) |
2078 |
|
(try-i i n want)))) |
2079 |
|
|
2080 |
;;; |
;;; |
2081 |
;;; floor |
;;; floor |
2082 |
;;; |
;;; |