Commit | Line | Data |
---|---|---|
61e61fbc JH |
1 | #!./perl |
2 | ||
3 | use strict; | |
4 | ||
5 | use Config; | |
6 | ||
7 | BEGIN { | |
8 | chdir 't' if -d 't'; | |
9 | require './test.pl'; | |
61e61fbc JH |
10 | } |
11 | ||
12 | plan(tests => 79); | |
13 | ||
14 | # Test hexfloat literals. | |
15 | ||
16 | is(0x0p0, 0); | |
17 | is(0x0.p0, 0); | |
18 | is(0x.0p0, 0); | |
19 | is(0x0.0p0, 0); | |
20 | is(0x0.00p0, 0); | |
21 | ||
22 | is(0x1p0, 1); | |
23 | is(0x1.p0, 1); | |
24 | is(0x1.0p0, 1); | |
25 | is(0x1.00p0, 1); | |
26 | ||
27 | is(0x2p0, 2); | |
28 | is(0x2.p0, 2); | |
29 | is(0x2.0p0, 2); | |
30 | is(0x2.00p0, 2); | |
31 | ||
32 | is(0x1p1, 2); | |
33 | is(0x1.p1, 2); | |
34 | is(0x1.0p1, 2); | |
35 | is(0x1.00p1, 2); | |
36 | ||
37 | is(0x.1p0, 0.0625); | |
38 | is(0x0.1p0, 0.0625); | |
39 | is(0x0.10p0, 0.0625); | |
40 | is(0x0.100p0, 0.0625); | |
41 | ||
42 | # Positive exponents. | |
43 | is(0x1p2, 4); | |
44 | is(0x1p+2, 4); | |
45 | is(0x0p+0, 0); | |
46 | ||
47 | # Negative exponents. | |
48 | is(0x1p-1, 0.5); | |
49 | is(0x1.p-1, 0.5); | |
50 | is(0x1.0p-1, 0.5); | |
51 | is(0x0p-0, 0); | |
52 | ||
53 | is(0x1p+2, 4); | |
54 | is(0x1p-2, 0.25); | |
55 | ||
56 | is(0x3p+2, 12); | |
57 | is(0x3p-2, 0.75); | |
58 | ||
59 | # Shifting left. | |
60 | is(0x1p2, 1 << 2); | |
61 | is(0x1p3, 1 << 3); | |
62 | is(0x3p4, 3 << 4); | |
63 | is(0x3p5, 3 << 5); | |
64 | is(0x12p23, 0x12 << 23); | |
65 | ||
66 | # Shifting right. | |
67 | is(0x1p-2, 1 / (1 << 2)); | |
68 | is(0x1p-3, 1 / (1 << 3)); | |
69 | is(0x3p-4, 3 / (1 << 4)); | |
70 | is(0x3p-5, 3 / (1 << 5)); | |
71 | is(0x12p-23, 0x12 / (1 << 23)); | |
72 | ||
73 | # Negative sign. | |
74 | is(-0x1p+2, -4); | |
75 | is(-0x1p-2, -0.25); | |
76 | is(-0x0p+0, 0); | |
77 | is(-0x0p-0, 0); | |
78 | ||
79 | is(0x0.10p0, 0.0625); | |
80 | is(0x0.1p0, 0.0625); | |
81 | is(0x.1p0, 0.0625); | |
82 | ||
83 | is(0x12p+3, 144); | |
84 | is(0x12p-3, 2.25); | |
85 | ||
86 | # Hexdigits (lowercase). | |
87 | is(0x9p+0, 9); | |
88 | is(0xap+0, 10); | |
89 | is(0xfp+0, 15); | |
90 | is(0x10p+0, 16); | |
91 | is(0x11p+0, 17); | |
92 | is(0xabp+0, 171); | |
93 | is(0xab.cdp+0, 171.80078125); | |
94 | ||
95 | # Uppercase hexdigits and exponent prefix. | |
96 | is(0xAp+0, 10); | |
97 | is(0xFp+0, 15); | |
98 | is(0xABP+0, 171); | |
99 | is(0xAB.CDP+0, 171.80078125); | |
100 | ||
101 | # Underbars. | |
102 | is(0xa_b.c_dp+1_2, 703696); | |
103 | ||
6c69a4c9 JH |
104 | # Note that the hexfloat representation is not unique since the |
105 | # exponent can be shifted, and the hexdigits with it: this is no | |
106 | # different from 3e4 cf 30e3 cf 30000. The shifting of the hexdigits | |
107 | # makes it look stranger, though: 0xap1 == 0x5p2. | |
61e61fbc JH |
108 | |
109 | # Needs to use within() instead of is() because of long doubles. | |
6c69a4c9 JH |
110 | within(0x1.99999999999ap-4, 0.1, 1e-9); |
111 | within(0x3.333333333333p-5, 0.1, 1e-9); | |
112 | within(0xc.cccccccccccdp-7, 0.1, 1e-9); | |
61e61fbc JH |
113 | |
114 | my $warn; | |
115 | ||
116 | local $SIG{__WARN__} = sub { $warn = shift }; | |
117 | ||
118 | sub get_warn() { | |
119 | my $save = $warn; | |
120 | undef $warn; | |
121 | return $save; | |
122 | } | |
123 | ||
124 | { # Test certain things that are not hexfloats and should stay that way. | |
125 | eval '0xp3'; | |
126 | like(get_warn(), qr/Missing operator before p3/); | |
127 | ||
128 | eval '5p3'; | |
129 | like(get_warn(), qr/Missing operator before p3/); | |
130 | ||
131 | my @a; | |
132 | eval '@a = 0x3..5'; | |
133 | is("@a", "3 4 5"); | |
134 | ||
135 | eval '$a = eval "0x.3"'; | |
136 | is($a, '03'); | |
137 | ||
138 | eval '$a = eval "0xc.3"'; | |
139 | is($a, '123'); | |
140 | } | |
141 | ||
142 | # Test warnings. | |
143 | SKIP: | |
144 | { | |
145 | if ($Config{nv_preserves_uv_bits} == 53) { | |
146 | local $^W = 1; | |
147 | ||
148 | eval '0x1_0000_0000_0000_0p0'; | |
149 | is(get_warn(), undef); | |
150 | ||
151 | eval '0x2_0000_0000_0000_0p0'; | |
152 | like(get_warn(), qr/^Hexadecimal float: mantissa overflow/); | |
153 | ||
154 | eval '0x1.0000_0000_0000_0p0'; | |
155 | is(get_warn(), undef); | |
156 | ||
157 | eval '0x2.0000_0000_0000_0p0'; | |
158 | like(get_warn(), qr/^Hexadecimal float: mantissa overflow/); | |
159 | ||
160 | eval '0x.1p-1021'; | |
161 | is(get_warn(), undef); | |
162 | ||
163 | eval '0x.1p-1023'; | |
164 | like(get_warn(), qr/^Hexadecimal float: exponent underflow/); | |
165 | ||
166 | eval '0x1.fffffffffffffp+1023'; | |
167 | is(get_warn(), undef); | |
168 | ||
169 | eval '0x1.fffffffffffffp+1024'; | |
170 | like(get_warn(), qr/^Hexadecimal float: exponent overflow/); | |
171 | } else { | |
172 | print "# skipping warning tests\n"; | |
173 | skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 8; | |
174 | } | |
175 | } | |
176 | ||
177 | # sprintf %a/%A testing is done in sprintf2.t, | |
178 | # trickier than necessary because of long doubles, | |
179 | # and because looseness of the spec. |