1#!perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 60;
7
8use Math::BigFloat;
9
10my @k = (16, 32, 64, 128);
11
12sub stringify {
13    my $x = shift;
14    return "$x" unless $x -> is_finite();
15    my $nstr = $x -> bnstr();
16    my $sstr = $x -> bsstr();
17    return length($nstr) < length($sstr) ? $nstr : $sstr;
18}
19
20for my $k (@k) {
21
22    # Parameters specific to this format:
23
24    my $b = 2;
25    my $p = $k == 16 ? 11
26          : $k == 32 ? 24
27          : $k == 64 ? 53
28          : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13;
29
30    $b = Math::BigFloat -> new($b);
31    $k = Math::BigFloat -> new($k);
32    $p = Math::BigFloat -> new($p);
33    my $w = $k - $p;
34
35    my $emax = 2 ** ($w - 1) - 1;
36    my $emin = 1 - $emax;
37
38    my $format = 'binary' . $k;
39
40    note("\nComputing test data for k = $k ...\n\n");
41
42    my $binv = Math::BigFloat -> new("0.5");
43
44    my $data =
45      [
46
47       {
48        dsc => "smallest positive subnormal number",
49        bin => "0"
50             . ("0" x $w)
51             . ("0" x ($p - 2)) . "1",
52        asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") "
53             . "= $b ** (" . ($emin + 1 - $p) . ")",
54        mbf => $binv ** ($p - 1 - $emin),
55       },
56
57       {
58        dsc => "largest subnormal number",
59        bin => "0"
60             . ("0" x $w)
61             . ("1" x ($p - 1)),
62        asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))",
63        mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)),
64       },
65
66       {
67        dsc => "smallest positive normal number",
68        bin => "0"
69             . ("0" x ($w - 1)) . "1"
70             . ("0" x ($p - 1)),
71        asc => "$b ** ($emin)",
72        mbf => $binv ** (-$emin),
73       },
74
75       {
76        dsc => "largest normal number",
77        bin => "0"
78             . ("1" x ($w - 1)) . "0"
79             . "1" x ($p - 1),
80        asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))",
81        mbf => $b ** $emax * ($b - $binv ** ($p - 1)),
82       },
83
84       {
85        dsc => "largest number less than one",
86        bin => "0"
87             . "0" . ("1" x ($w - 2)) . "0"
88             . "1" x ($p - 1),
89        asc => "1 - $b ** (-$p)",
90        mbf => 1 - $binv ** $p,
91       },
92
93       {
94        dsc => "smallest number larger than one",
95        bin => "0"
96             . "0" . ("1" x ($w - 1))
97             . ("0" x ($p - 2)) . "1",
98        asc => "1 + $b ** (" . (1 - $p) . ")",
99        mbf => 1 + $binv ** ($p - 1),
100       },
101
102       {
103        dsc => "second smallest number larger than one",
104        bin => "0"
105             . "0" . ("1" x ($w - 1))
106             . ("0" x ($p - 3)) . "10",
107        asc => "1 + $b ** (" . (2 - $p) . ")",
108        mbf => 1 + $binv ** ($p - 2),
109       },
110
111       {
112        dsc => "one",
113        bin => "0"
114             . "0" . ("1" x ($w - 1))
115             . "0" x ($p - 1),
116        asc => "1",
117        mbf => Math::BigFloat -> new("1"),
118       },
119
120       {
121        dsc => "minus one",
122        bin => "1"
123             . "0" . ("1" x ($w - 1))
124             . "0" x ($p - 1),
125        asc => "-1",
126        mbf => Math::BigFloat -> new("-1"),
127       },
128
129       {
130        dsc => "two",
131        bin => "0"
132             . "1" . ("0" x ($w - 1))
133             . ("0" x ($p - 1)),
134        asc => "2",
135        mbf => Math::BigFloat -> new("2"),
136       },
137
138       {
139        dsc => "minus two",
140        bin => "1"
141             . "1" . ("0" x ($w - 1))
142             . ("0" x ($p - 1)),
143        asc => "-2",
144        mbf => Math::BigFloat -> new("-2"),
145       },
146
147       {
148        dsc => "positive zero",
149        bin => "0"
150             . ("0" x $w)
151             . ("0" x ($p - 1)),
152        asc => "+0",
153        mbf => Math::BigFloat -> new("0"),
154       },
155
156       {
157        dsc => "positive infinity",
158        bin => "0"
159             . ("1" x $w)
160             . ("0" x ($p - 1)),
161        asc => "+inf",
162        mbf => Math::BigFloat -> new("inf"),
163       },
164
165       {
166        dsc => "negative infinity",
167        bin =>  "1"
168             . ("1" x $w)
169             . ("0" x ($p - 1)),
170        asc => "-inf",
171        mbf => Math::BigFloat -> new("-inf"),
172       },
173
174       {
175        dsc => "NaN (encoding used by Perl on Cygwin)",
176        bin => "1"
177             . ("1" x $w)
178             . ("1" . ("0" x ($p - 2))),
179        asc => "NaN",
180        mbf => Math::BigFloat -> new("NaN"),
181       },
182
183      ];
184
185    for my $entry (@$data) {
186        my $bin   = $entry -> {bin};
187        my $bytes = pack "B*", $bin;
188        my $hex   = unpack "H*", $bytes;
189
190        note("\n", $entry -> {dsc}, " (k = $k): ", $entry -> {asc}, "\n\n");
191
192        my $x = $entry -> {mbf};
193
194        my $test = qq|Math::BigFloat -> new("| . stringify($x)
195                 . qq|") -> to_ieee754("$format")|;
196
197        my $got_bytes = $x -> to_ieee754($format);
198        my $got_hex = unpack "H*", $got_bytes;
199        $got_hex =~ s/(..)/\\x$1/g;
200
201        my $expected_hex = $hex;
202        $expected_hex =~ s/(..)/\\x$1/g;
203
204        is($got_hex, $expected_hex);
205    }
206}
207