This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Follow-up on a149d118.
[perl5.git] / t / op / hexfp.t
CommitLineData
61e61fbc
JH
1#!./perl
2
61e61fbc
JH
3BEGIN {
4 chdir 't' if -d 't';
9224f6d1 5 @INC = '../lib';
61e61fbc 6 require './test.pl';
61e61fbc
JH
7}
8
0b1b7115
JH
9use strict;
10
11use Config;
12
a149d118 13plan(tests => 109);
61e61fbc
JH
14
15# Test hexfloat literals.
16
17is(0x0p0, 0);
18is(0x0.p0, 0);
19is(0x.0p0, 0);
20is(0x0.0p0, 0);
21is(0x0.00p0, 0);
22
23is(0x1p0, 1);
24is(0x1.p0, 1);
25is(0x1.0p0, 1);
26is(0x1.00p0, 1);
27
28is(0x2p0, 2);
29is(0x2.p0, 2);
30is(0x2.0p0, 2);
31is(0x2.00p0, 2);
32
33is(0x1p1, 2);
34is(0x1.p1, 2);
35is(0x1.0p1, 2);
36is(0x1.00p1, 2);
37
38is(0x.1p0, 0.0625);
39is(0x0.1p0, 0.0625);
40is(0x0.10p0, 0.0625);
41is(0x0.100p0, 0.0625);
42
eba98284
JH
43is(0x.1p0, 0.0625);
44is(0x1.1p0, 1.0625);
45is(0x1.11p0, 1.06640625);
46is(0x1.111p0, 1.066650390625);
47
61e61fbc
JH
48# Positive exponents.
49is(0x1p2, 4);
50is(0x1p+2, 4);
51is(0x0p+0, 0);
52
53# Negative exponents.
54is(0x1p-1, 0.5);
55is(0x1.p-1, 0.5);
56is(0x1.0p-1, 0.5);
57is(0x0p-0, 0);
58
59is(0x1p+2, 4);
60is(0x1p-2, 0.25);
61
62is(0x3p+2, 12);
63is(0x3p-2, 0.75);
64
65# Shifting left.
66is(0x1p2, 1 << 2);
67is(0x1p3, 1 << 3);
68is(0x3p4, 3 << 4);
69is(0x3p5, 3 << 5);
70is(0x12p23, 0x12 << 23);
71
72# Shifting right.
73is(0x1p-2, 1 / (1 << 2));
74is(0x1p-3, 1 / (1 << 3));
75is(0x3p-4, 3 / (1 << 4));
76is(0x3p-5, 3 / (1 << 5));
77is(0x12p-23, 0x12 / (1 << 23));
78
79# Negative sign.
80is(-0x1p+2, -4);
81is(-0x1p-2, -0.25);
82is(-0x0p+0, 0);
83is(-0x0p-0, 0);
84
85is(0x0.10p0, 0.0625);
86is(0x0.1p0, 0.0625);
87is(0x.1p0, 0.0625);
88
89is(0x12p+3, 144);
90is(0x12p-3, 2.25);
91
92# Hexdigits (lowercase).
93is(0x9p+0, 9);
94is(0xap+0, 10);
95is(0xfp+0, 15);
96is(0x10p+0, 16);
97is(0x11p+0, 17);
98is(0xabp+0, 171);
99is(0xab.cdp+0, 171.80078125);
100
101# Uppercase hexdigits and exponent prefix.
102is(0xAp+0, 10);
103is(0xFp+0, 15);
104is(0xABP+0, 171);
105is(0xAB.CDP+0, 171.80078125);
106
107# Underbars.
108is(0xa_b.c_dp+1_2, 703696);
109
6c69a4c9
JH
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.
61e61fbc 114
eba98284
JH
115# [perl #127183], try some non-canonical forms.
116SKIP: {
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
61e61fbc 124# Needs to use within() instead of is() because of long doubles.
6c69a4c9
JH
125within(0x1.99999999999ap-4, 0.1, 1e-9);
126within(0x3.333333333333p-5, 0.1, 1e-9);
127within(0xc.cccccccccccdp-7, 0.1, 1e-9);
61e61fbc
JH
128
129my $warn;
130
131local $SIG{__WARN__} = sub { $warn = shift };
132
133sub 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
eba98284 150 undef $a;
61e61fbc
JH
151 eval '$a = eval "0x.3"';
152 is($a, '03');
153
eba98284 154 undef $a;
61e61fbc
JH
155 eval '$a = eval "0xc.3"';
156 is($a, '123');
eba98284
JH
157
158 undef $a;
159 eval '$a = eval "0x.p3"';
160 is($a, undef);
61e61fbc
JH
161}
162
163# Test warnings.
164SKIP:
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/);
0c8adad7
JH
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);
96524c28
JH
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);
61e61fbc
JH
240 } else {
241 print "# skipping warning tests\n";
96524c28 242 skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 26;
61e61fbc
JH
243 }
244}
245
a149d118
JH
246# [perl #128919] limited exponent range in hex fp literal with long double
247SKIP: {
73013786
JH
248 skip("non-80-bit-long-double", 4)
249 unless ($Config{uselongdouble} &&
250 ($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
251 ($Config{longdblkind} == 3 ||
252 $Config{longdblkind} == 4));
a149d118
JH
253 is(0x1p-1074, 4.94065645841246544e-324);
254 is(0x1p-1075, 2.47032822920623272e-324, '[perl #128919]');
255 is(0x1p-1076, 1.23516411460311636e-324);
256 is(0x1p-16445, 3.6451995318824746e-4951);
257}
258
61e61fbc
JH
259# sprintf %a/%A testing is done in sprintf2.t,
260# trickier than necessary because of long doubles,
261# and because looseness of the spec.