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