d6c04828860f8fc0eb2d55a0bc7dad27b09c62c9
[perl.git] / t / op / hexfp.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10
11 use Config;
12
13 plan(tests => 109);
14
15 # Test hexfloat literals.
16
17 is(0x0p0, 0);
18 is(0x0.p0, 0);
19 is(0x.0p0, 0);
20 is(0x0.0p0, 0);
21 is(0x0.00p0, 0);
22
23 is(0x1p0, 1);
24 is(0x1.p0, 1);
25 is(0x1.0p0, 1);
26 is(0x1.00p0, 1);
27
28 is(0x2p0, 2);
29 is(0x2.p0, 2);
30 is(0x2.0p0, 2);
31 is(0x2.00p0, 2);
32
33 is(0x1p1, 2);
34 is(0x1.p1, 2);
35 is(0x1.0p1, 2);
36 is(0x1.00p1, 2);
37
38 is(0x.1p0, 0.0625);
39 is(0x0.1p0, 0.0625);
40 is(0x0.10p0, 0.0625);
41 is(0x0.100p0, 0.0625);
42
43 is(0x.1p0, 0.0625);
44 is(0x1.1p0, 1.0625);
45 is(0x1.11p0, 1.06640625);
46 is(0x1.111p0, 1.066650390625);
47
48 # Positive exponents.
49 is(0x1p2, 4);
50 is(0x1p+2, 4);
51 is(0x0p+0, 0);
52
53 # Negative exponents.
54 is(0x1p-1, 0.5);
55 is(0x1.p-1, 0.5);
56 is(0x1.0p-1, 0.5);
57 is(0x0p-0, 0);
58
59 is(0x1p+2, 4);
60 is(0x1p-2, 0.25);
61
62 is(0x3p+2, 12);
63 is(0x3p-2, 0.75);
64
65 # Shifting left.
66 is(0x1p2, 1 << 2);
67 is(0x1p3, 1 << 3);
68 is(0x3p4, 3 << 4);
69 is(0x3p5, 3 << 5);
70 is(0x12p23, 0x12 << 23);
71
72 # Shifting right.
73 is(0x1p-2, 1 / (1 << 2));
74 is(0x1p-3, 1 / (1 << 3));
75 is(0x3p-4, 3 / (1 << 4));
76 is(0x3p-5, 3 / (1 << 5));
77 is(0x12p-23, 0x12 / (1 << 23));
78
79 # Negative sign.
80 is(-0x1p+2, -4);
81 is(-0x1p-2, -0.25);
82 is(-0x0p+0, 0);
83 is(-0x0p-0, 0);
84
85 is(0x0.10p0, 0.0625);
86 is(0x0.1p0, 0.0625);
87 is(0x.1p0, 0.0625);
88
89 is(0x12p+3, 144);
90 is(0x12p-3, 2.25);
91
92 # Hexdigits (lowercase).
93 is(0x9p+0, 9);
94 is(0xap+0, 10);
95 is(0xfp+0, 15);
96 is(0x10p+0, 16);
97 is(0x11p+0, 17);
98 is(0xabp+0, 171);
99 is(0xab.cdp+0, 171.80078125);
100
101 # Uppercase hexdigits and exponent prefix.
102 is(0xAp+0, 10);
103 is(0xFp+0, 15);
104 is(0xABP+0, 171);
105 is(0xAB.CDP+0, 171.80078125);
106
107 # Underbars.
108 is(0xa_b.c_dp+1_2, 703696);
109
110 # Note that the hexfloat representation is not unique since the
111 # exponent can be shifted, and the hexdigits with it: this is no
112 # different from 3e4 cf 30e3 cf 30000.  The shifting of the hexdigits
113 # makes it look stranger, though: 0xap1 == 0x5p2.
114
115 # [perl #127183], try some non-canonical forms.
116 SKIP: {
117     skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 3)
118         unless ($Config{nv_preserves_uv_bits} == 53);
119     is(0x0.b17217f7d1cf78p0, 0x1.62e42fefa39efp-1);
120     is(0x0.58b90bfbe8e7bcp1, 0x1.62e42fefa39efp-1);
121     is(0x0.2c5c85fdf473dep2, 0x1.62e42fefa39efp-1);
122 }
123
124 # Needs to use within() instead of is() because of long doubles.
125 within(0x1.99999999999ap-4, 0.1, 1e-9);
126 within(0x3.333333333333p-5, 0.1, 1e-9);
127 within(0xc.cccccccccccdp-7, 0.1, 1e-9);
128
129 my $warn;
130
131 local $SIG{__WARN__} = sub { $warn = shift };
132
133 sub get_warn() {
134     my $save = $warn;
135     undef $warn;
136     return $save;
137 }
138
139 { # Test certain things that are not hexfloats and should stay that way.
140     eval '0xp3';
141     like(get_warn(), qr/Missing operator before p3/);
142
143     eval '5p3';
144     like(get_warn(), qr/Missing operator before p3/);
145
146     my @a;
147     eval '@a = 0x3..5';
148     is("@a", "3 4 5");
149
150     undef $a;
151     eval '$a = eval "0x.3"';
152     is($a, '03');
153
154     undef $a;
155     eval '$a = eval "0xc.3"';
156     is($a, '123');
157
158     undef $a;
159     eval '$a = eval "0x.p3"';
160     is($a, undef);
161 }
162
163 # Test warnings.
164 SKIP:
165 {
166     if ($Config{nv_preserves_uv_bits} == 53) {
167         local $^W = 1;
168
169         eval '0x1_0000_0000_0000_0p0';
170         is(get_warn(), undef);
171
172         eval '0x2_0000_0000_0000_0p0';
173         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
174
175         eval '0x1.0000_0000_0000_0p0';
176         is(get_warn(), undef);
177
178         eval '0x2.0000_0000_0000_0p0';
179         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
180
181         eval '0x.1p-1021';
182         is(get_warn(), undef);
183
184         eval '0x.1p-1023';
185         like(get_warn(), qr/^Hexadecimal float: exponent underflow/);
186
187         eval '0x1.fffffffffffffp+1023';
188         is(get_warn(), undef);
189
190         eval '0x1.fffffffffffffp+1024';
191         like(get_warn(), qr/^Hexadecimal float: exponent overflow/);
192
193         undef $a;
194         eval '$a = 0x111.0000000000000p+0'; # 12 zeros.
195         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
196         is($a, 273);
197
198         # The 13 zeros would be enough to push the hi-order digits
199         # off the high-end.
200
201         undef $a;
202         eval '$a = 0x111.0000000000000p+0'; # 13 zeros.
203         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
204         is($a, 273);
205
206         undef $a;
207         eval '$a = 0x111.00000000000000p+0';  # 14 zeros.
208         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
209         is($a, 273);
210
211         undef $a;
212         eval '$a = 0xfffffffffffffp0';  # 52 bits.
213         is(get_warn(), undef);
214         is($a, 4.5035996273705e+15);
215
216         undef $a;
217         eval '$a = 0xfffffffffffff.8p0';  # 53 bits.
218         is(get_warn(), undef);
219         is($a, 4.5035996273705e+15);
220
221         undef $a;
222         eval '$a = 0xfffffffffffff.cp0';  # 54 bits.
223         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
224         is($a, 4.5035996273705e+15);
225
226         undef $a;
227         eval '$a = 0xf.ffffffffffffp0';  # 52 bits.
228         is(get_warn(), undef);
229         is($a, 16);
230
231         undef $a;
232         eval '$a = 0xf.ffffffffffff8p0';  # 53 bits.
233         is(get_warn(), undef);
234         is($a, 16);
235
236         undef $a;
237         eval '$a = 0xf.ffffffffffffcp0';  # 54 bits.
238         like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
239         is($a, 16);
240     } else {
241         print "# skipping warning tests\n";
242         skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 26;
243     }
244 }
245
246 # [perl #128919] limited exponent range in hex fp literal with long double
247 SKIP: {
248     skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 64", 4)
249         unless ($Config{nv_preserves_uv_bits} == 64);
250     is(0x1p-1074,  4.94065645841246544e-324);
251     is(0x1p-1075,  2.47032822920623272e-324, '[perl #128919]');
252     is(0x1p-1076,  1.23516411460311636e-324);
253     is(0x1p-16445, 3.6451995318824746e-4951);
254 }
255
256 # sprintf %a/%A testing is done in sprintf2.t,
257 # trickier than necessary because of long doubles,
258 # and because looseness of the spec.