source: trunk/abcl/t/decode-float.lisp

Last change on this file was 15292, checked in by Mark Evenson, 4 years ago

Further fixes for floating point values

DECODE-FLOAT now returns a significand in the interval between 1/2
(inclusive) and 1 (exclusive) as implied by ANSI.

Coercion of values smaller than 2-1023 to double floats no longer
returns zero.

Completed addressing the issues raised by Robert Dodier in
<​https://github.com/armedbear/abcl/issues/93>,
<​https://github.com/armedbear/abcl/issues/94>, and
<​https://github.com/armedbear/abcl/issues/95>.
File size: 2.8 KB
Line 
1(in-package :cl-user)
2
3;;; <https://github.com/armedbear/abcl/issues/93>
4(let ((floats `(1f0
5                1f6
6                1f-6
7                ,least-positive-normalized-single-float
8                ,least-positive-single-float)))
9  (prove:plan (length floats))
10  (dolist (float floats)
11    (multiple-value-bind (quotient exponent sign)
12        (decode-float float)
13      (let ((radix (float-radix float)))
14        (let ((lower (/ 1 radix)))
15          (prove:ok
16           (and (< quotient 1)
17                (>= quotient lower))
18           (format nil "Whether ~a lies within (1 ~a]" quotient lower)))))))
19
20;;; <https://github.com/armedbear/abcl/issues/94>
21(let ((floats `(,least-positive-normalized-double-float
22                ,(/ least-positive-normalized-double-float 2)
23                ,(/ least-positive-normalized-double-float 4)
24                ,(/ least-positive-normalized-double-float 8)
25                ,(/ least-positive-normalized-double-float 16)
26                ,(/ least-positive-normalized-double-float 1024))))
27  (prove:plan (length floats))
28  (dolist (float floats)
29    (multiple-value-bind (quotient exponent sign)
30        (decode-float float)
31      (let ((radix (float-radix float)))
32        (let ((lower (/ 1 radix)))
33          (prove:ok
34           (and (< quotient 1)
35                (>= quotient lower))
36           (format nil "Whether ~a lies within  (1 ~a]" quotient lower)))))))
37
38;;; <https://github.com/armedbear/abcl/issues/95>
39(let ((floats `(1d0 ,most-positive-double-float ,least-positive-double-float)))
40  (prove:plan (* 2 (length floats)))
41  (dolist (float floats)
42    (prove:is-type float 'double-float)
43    (let ((result (decode-float float)))
44      (prove:is-type result 'double-float))))
45
46;; From the REPL, I don't get a signaled condition, but these tests succeed

47(let ((infinities '(single-float-positive-infinity
48                    single-float-negative-infinity
49                    double-float-positive-infinity
50                    double-float-negative-infinity)))
51  (prove:plan (length infinities))
52  (dolist (infinity infinities)
53    (prove:is-error
54     (decode-float infinity)
55     'error
56     (format nil "Attempting to DECODE-FLOAT ~a should signal error" infinity))))
57
58
59(let ((floats `(1f0
60                1d0
61                1f6
62                1d6
63                1f-6
64                1d-6
65                ,least-positive-normalized-single-float
66                ,least-positive-single-float
67                ,least-positive-normalized-double-float
68                ,least-positive-double-float)))
69  (prove:plan (length floats))
70  (dolist (float floats)
71    (multiple-value-bind (significand exponent sign)
72        (integer-decode-float float)
73      (prove:is
74       (coerce (* significand (expt 2 exponent)) (type-of float))
75       float
76       (format nil "INTEGER-DECODE-FLOAT roundtrips for ~s" float)))))
77
78
79(prove:finalize)
Note: See TracBrowser for help on using the repository browser.