Commit | Line | Data |
---|---|---|
11883c88 | 1 | #!./perl |
e312add1 | 2 | |
0f4b6630 | 3 | BEGIN { |
11883c88 NC |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | eval { my $q = pack "q", 0 }; | |
8 | skip_all('no 64-bit types') if $@; | |
0f4b6630 JH |
9 | } |
10 | ||
686fa4bb | 11 | # This could use many more tests. |
0f4b6630 | 12 | |
d0ba1bd2 | 13 | # so that using > 0xfffffff constants and |
972b05a9 | 14 | # 32+ bit integers don't cause noise |
59d8ce62 | 15 | use warnings; |
4438c4b7 | 16 | no warnings qw(overflow portable); |
3dfaac44 | 17 | use Config; |
ea2b5ef6 | 18 | |
59d8ce62 NC |
19 | # as 6 * 6 = 36, the last digit of 6**n will always be six. Hence the last |
20 | # digit of 16**n will always be six. Hence 16**n - 1 will always end in 5. | |
21 | # Assumption is that UVs will always be a multiple of 4 bits long. | |
22 | ||
23 | my $UV_max = ~0; | |
24 | die "UV_max eq '$UV_max', doesn't end in 5; your UV isn't 4n bits long :-(." | |
25 | unless $UV_max =~ /5$/; | |
26 | my $UV_max_less3 = $UV_max - 3; | |
27 | my $maths_preserves_UVs = $UV_max_less3 =~ /^\d+2$/; # 5 - 3 is 2. | |
28 | if ($maths_preserves_UVs) { | |
29 | print "# This perl's maths preserves all bits of a UV.\n"; | |
30 | } else { | |
31 | print "# This perl's maths does not preserve all bits of a UV.\n"; | |
32 | } | |
33 | ||
0f4b6630 JH |
34 | my $q = 12345678901; |
35 | my $r = 23456789012; | |
20fe1ea2 | 36 | my $f = 0xffffffff; |
0f4b6630 | 37 | my $x; |
2d4389e4 | 38 | my $y; |
0f4b6630 JH |
39 | |
40 | $x = unpack "q", pack "q", $q; | |
11883c88 NC |
41 | cmp_ok($x, '==', $q); |
42 | cmp_ok($x, '>', $f); | |
0f4b6630 JH |
43 | |
44 | ||
22f3ae8c | 45 | $x = sprintf("%lld", 12345678901); |
11883c88 NC |
46 | is($x, $q); |
47 | cmp_ok($x, '>', $f); | |
0f4b6630 | 48 | |
0f4b6630 | 49 | $x = sprintf("%lld", $q); |
11883c88 NC |
50 | cmp_ok($x, '==', $q); |
51 | is($x, $q); | |
52 | cmp_ok($x, '>', $f); | |
0f4b6630 JH |
53 | |
54 | $x = sprintf("%Ld", $q); | |
11883c88 NC |
55 | cmp_ok($x, '==', $q); |
56 | is($x, $q); | |
57 | cmp_ok($x, '>', $f); | |
0f4b6630 JH |
58 | |
59 | $x = sprintf("%qd", $q); | |
11883c88 NC |
60 | cmp_ok($x, '==', $q); |
61 | is($x, $q); | |
62 | cmp_ok($x, '>', $f); | |
0f4b6630 | 63 | |
0f4b6630 JH |
64 | |
65 | $x = sprintf("%llx", $q); | |
11883c88 NC |
66 | cmp_ok(hex $x, '==', 0x2dfdc1c35); |
67 | cmp_ok(hex $x, '>', $f); | |
0f4b6630 JH |
68 | |
69 | $x = sprintf("%Lx", $q); | |
11883c88 NC |
70 | cmp_ok(hex $x, '==', 0x2dfdc1c35); |
71 | cmp_ok(hex $x, '>', $f); | |
0f4b6630 JH |
72 | |
73 | $x = sprintf("%qx", $q); | |
11883c88 NC |
74 | cmp_ok(hex $x, '==', 0x2dfdc1c35); |
75 | cmp_ok(hex $x, '>', $f); | |
0f4b6630 JH |
76 | |
77 | $x = sprintf("%llo", $q); | |
11883c88 NC |
78 | cmp_ok(oct "0$x", '==', 0133767016065); |
79 | cmp_ok(oct $x, '>', $f); | |
0f4b6630 JH |
80 | |
81 | $x = sprintf("%Lo", $q); | |
11883c88 NC |
82 | cmp_ok(oct "0$x", '==', 0133767016065); |
83 | cmp_ok(oct $x, '>', $f); | |
0f4b6630 JH |
84 | |
85 | $x = sprintf("%qo", $q); | |
11883c88 NC |
86 | cmp_ok(oct "0$x", '==', 0133767016065); |
87 | cmp_ok(oct $x, '>', $f); | |
0f4b6630 JH |
88 | |
89 | $x = sprintf("%llb", $q); | |
11883c88 NC |
90 | cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101); |
91 | cmp_ok(oct "0b$x", '>', $f); | |
0f4b6630 JH |
92 | |
93 | $x = sprintf("%Lb", $q); | |
11883c88 NC |
94 | cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101); |
95 | cmp_ok(oct "0b$x", '>', $f); | |
0f4b6630 JH |
96 | |
97 | $x = sprintf("%qb", $q); | |
11883c88 NC |
98 | cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101); |
99 | cmp_ok(oct "0b$x", '>', $f); | |
0f4b6630 JH |
100 | |
101 | ||
22f3ae8c | 102 | $x = sprintf("%llu", $q); |
11883c88 NC |
103 | is($x, $q); |
104 | cmp_ok($x, '>', $f); | |
0f4b6630 | 105 | |
22f3ae8c | 106 | $x = sprintf("%Lu", $q); |
11883c88 NC |
107 | cmp_ok($x, '==', $q); |
108 | is($x, $q); | |
109 | cmp_ok($x, '>', $f); | |
0f4b6630 | 110 | |
22f3ae8c | 111 | $x = sprintf("%qu", $q); |
11883c88 NC |
112 | cmp_ok($x, '==', $q); |
113 | is($x, $q); | |
114 | cmp_ok($x, '>', $f); | |
0f4b6630 JH |
115 | |
116 | ||
29fe7a80 | 117 | $x = sprintf("%D", $q); |
11883c88 NC |
118 | cmp_ok($x, '==', $q); |
119 | is($x, $q); | |
120 | cmp_ok($x, '>', $f); | |
29fe7a80 JH |
121 | |
122 | $x = sprintf("%U", $q); | |
11883c88 NC |
123 | cmp_ok($x, '==', $q); |
124 | is($x, $q); | |
125 | cmp_ok($x, '>', $f); | |
29fe7a80 JH |
126 | |
127 | $x = sprintf("%O", $q); | |
11883c88 NC |
128 | cmp_ok(oct $x, '==', $q); |
129 | cmp_ok(oct $x, '>', $f); | |
29fe7a80 JH |
130 | |
131 | ||
0f4b6630 | 132 | $x = $q + $r; |
11883c88 NC |
133 | cmp_ok($x, '==', 35802467913); |
134 | cmp_ok($x, '>', $f); | |
0f4b6630 JH |
135 | |
136 | $x = $q - $r; | |
11883c88 NC |
137 | cmp_ok($x, '==', -11111110111); |
138 | cmp_ok(-$x, '>', $f); | |
139 | ||
140 | SKIP: { | |
141 | # Unicos has imprecise doubles (14 decimal digits or so), | |
142 | # especially if operating near the UV/IV limits the low-order bits | |
143 | # become mangled even by simple arithmetic operations. | |
144 | skip('too imprecise numbers on unicos') if $^O eq 'unicos'; | |
0f4b6630 | 145 | |
f3ff050f | 146 | $x = $q * 1234567; |
11883c88 NC |
147 | cmp_ok($x, '==', 15241567763770867); |
148 | cmp_ok($x, '>', $f); | |
0f4b6630 | 149 | |
8d489514 | 150 | $x /= 1234567; |
11883c88 NC |
151 | cmp_ok($x, '==', $q); |
152 | cmp_ok($x, '>', $f); | |
2d4389e4 | 153 | |
8d489514 | 154 | $x = 98765432109 % 12345678901; |
11883c88 NC |
155 | cmp_ok($x, '==', 901); |
156 | ||
8d489514 | 157 | # The following 12 tests adapted from op/inc. |
2d4389e4 | 158 | |
f3ff050f JH |
159 | $a = 9223372036854775807; |
160 | $c = $a++; | |
11883c88 | 161 | cmp_ok($a, '==', 9223372036854775808); |
f3ff050f JH |
162 | |
163 | $a = 9223372036854775807; | |
164 | $c = ++$a; | |
11883c88 NC |
165 | cmp_ok($a, '==', 9223372036854775808); |
166 | cmp_ok($c, '==', $a); | |
f3ff050f JH |
167 | |
168 | $a = 9223372036854775807; | |
169 | $c = $a + 1; | |
11883c88 NC |
170 | cmp_ok($a, '==', 9223372036854775807); |
171 | cmp_ok($c, '==', 9223372036854775808); | |
f3ff050f JH |
172 | |
173 | $a = -9223372036854775808; | |
a12a6a4d NC |
174 | { |
175 | no warnings 'imprecision'; | |
176 | $c = $a--; | |
177 | } | |
11883c88 NC |
178 | cmp_ok($a, '==', -9223372036854775809); |
179 | cmp_ok($c, '==', -9223372036854775808); | |
f3ff050f JH |
180 | |
181 | $a = -9223372036854775808; | |
a12a6a4d NC |
182 | { |
183 | no warnings 'imprecision'; | |
184 | $c = --$a; | |
185 | } | |
11883c88 NC |
186 | cmp_ok($a, '==', -9223372036854775809); |
187 | cmp_ok($c, '==', $a); | |
f3ff050f JH |
188 | |
189 | $a = -9223372036854775808; | |
190 | $c = $a - 1; | |
11883c88 NC |
191 | cmp_ok($a, '==', -9223372036854775808); |
192 | cmp_ok($c, '==', -9223372036854775809); | |
193 | ||
f3ff050f JH |
194 | $a = 9223372036854775808; |
195 | $a = -$a; | |
a12a6a4d NC |
196 | { |
197 | no warnings 'imprecision'; | |
198 | $c = $a--; | |
199 | } | |
11883c88 NC |
200 | cmp_ok($a, '==', -9223372036854775809); |
201 | cmp_ok($c, '==', -9223372036854775808); | |
202 | ||
f3ff050f JH |
203 | $a = 9223372036854775808; |
204 | $a = -$a; | |
a12a6a4d NC |
205 | { |
206 | no warnings 'imprecision'; | |
207 | $c = --$a; | |
208 | } | |
11883c88 NC |
209 | cmp_ok($a, '==', -9223372036854775809); |
210 | cmp_ok($c, '==', $a); | |
211 | ||
f3ff050f JH |
212 | $a = 9223372036854775808; |
213 | $a = -$a; | |
214 | $c = $a - 1; | |
11883c88 NC |
215 | cmp_ok($a, '==', -9223372036854775808); |
216 | cmp_ok($c, '==', -9223372036854775809); | |
f3ff050f JH |
217 | |
218 | $a = 9223372036854775808; | |
219 | $b = -$a; | |
a12a6a4d NC |
220 | { |
221 | no warnings 'imprecision'; | |
222 | $c = $b--; | |
223 | } | |
11883c88 NC |
224 | cmp_ok($b, '==', -$a-1); |
225 | cmp_ok($c, '==', -$a); | |
f3ff050f JH |
226 | |
227 | $a = 9223372036854775808; | |
228 | $b = -$a; | |
a12a6a4d NC |
229 | { |
230 | no warnings 'imprecision'; | |
231 | $c = --$b; | |
232 | } | |
11883c88 NC |
233 | cmp_ok($b, '==', -$a-1); |
234 | cmp_ok($c, '==', $b); | |
f3ff050f JH |
235 | |
236 | $a = 9223372036854775808; | |
237 | $b = -$a; | |
238 | $b = $b - 1; | |
11883c88 | 239 | cmp_ok($b, '==', -(++$a)); |
f3ff050f | 240 | } |
e312add1 | 241 | |
2d4389e4 | 242 | |
c5a0f51a | 243 | $x = ''; |
11883c88 | 244 | cmp_ok((vec($x, 1, 64) = $q), '==', $q); |
c5a0f51a | 245 | |
11883c88 NC |
246 | cmp_ok(vec($x, 1, 64), '==', $q); |
247 | cmp_ok(vec($x, 1, 64), '>', $f); | |
972b05a9 | 248 | |
11883c88 NC |
249 | cmp_ok(vec($x, 0, 64), '==', 0); |
250 | cmp_ok(vec($x, 2, 64), '==', 0); | |
972b05a9 | 251 | |
11883c88 | 252 | cmp_ok(~0, '==', 0xffffffffffffffff); |
972b05a9 | 253 | |
11883c88 | 254 | cmp_ok((0xffffffff<<32), '==', 0xffffffff00000000); |
972b05a9 | 255 | |
11883c88 | 256 | cmp_ok(((0xffffffff)<<32)>>32, '==', 0xffffffff); |
972b05a9 | 257 | |
11883c88 | 258 | cmp_ok(1<<63, '==', 0x8000000000000000); |
972b05a9 | 259 | |
11883c88 | 260 | is((sprintf "%#Vx", 1<<63), '0x8000000000000000'); |
972b05a9 | 261 | |
11883c88 | 262 | cmp_ok((0x8000000000000000 | 1), '==', 0x8000000000000001); |
972b05a9 | 263 | |
11883c88 NC |
264 | cmp_ok((0xf000000000000000 & 0x8000000000000000), '==', 0x8000000000000000); |
265 | cmp_ok((0xf000000000000000 ^ 0xfffffffffffffff0), '==', 0x0ffffffffffffff0); | |
972b05a9 | 266 | |
686fa4bb | 267 | |
11883c88 NC |
268 | is((sprintf "%b", ~0), |
269 | '1111111111111111111111111111111111111111111111111111111111111111'); | |
686fa4bb | 270 | |
686fa4bb | 271 | |
11883c88 NC |
272 | is((sprintf "%64b", ~0), |
273 | '1111111111111111111111111111111111111111111111111111111111111111'); | |
686fa4bb | 274 | |
11883c88 NC |
275 | is((sprintf "%d", ~0>>1),'9223372036854775807'); |
276 | is((sprintf "%u", ~0),'18446744073709551615'); | |
686fa4bb | 277 | |
868d6b85 JH |
278 | # If the 53..55 fail you have problems in the parser's string->int conversion, |
279 | # see toke.c:scan_num(). | |
280 | ||
281 | $q = -9223372036854775808; | |
11883c88 | 282 | is("$q","-9223372036854775808"); |
868d6b85 JH |
283 | |
284 | $q = 9223372036854775807; | |
11883c88 | 285 | is("$q","9223372036854775807"); |
868d6b85 JH |
286 | |
287 | $q = 18446744073709551615; | |
11883c88 | 288 | is("$q","18446744073709551615"); |
868d6b85 | 289 | |
85b81d93 NC |
290 | # Test that sv_2nv then sv_2iv is the same as sv_2iv direct |
291 | # fails if whatever Atol is defined as can't actually cope with >32 bits. | |
292 | my $num = 4294967297; | |
293 | my $string = "4294967297"; | |
294 | { | |
295 | use integer; | |
296 | $num += 0; | |
297 | $string += 0; | |
298 | } | |
11883c88 | 299 | is($num, $string); |
85b81d93 NC |
300 | |
301 | # Test that sv_2nv then sv_2uv is the same as sv_2uv direct | |
302 | $num = 4294967297; | |
303 | $string = "4294967297"; | |
304 | $num &= 0; | |
305 | $string &= 0; | |
11883c88 | 306 | is($num, $string); |
85b81d93 | 307 | |
09bb3e27 NC |
308 | $q = "18446744073709551616e0"; |
309 | $q += 0; | |
11883c88 | 310 | isnt($q, "18446744073709551615"); |
09bb3e27 | 311 | |
5479d192 NC |
312 | # 0xFFFFFFFFFFFFFFFF == 1 * 3 * 5 * 17 * 257 * 641 * 65537 * 6700417' |
313 | $q = 0xFFFFFFFFFFFFFFFF / 3; | |
11883c88 NC |
314 | cmp_ok($q, '==', 0x5555555555555555); |
315 | SKIP: { | |
316 | skip("Maths does not preserve UVs", 2) unless $maths_preserves_UVs; | |
317 | cmp_ok($q, '!=', 0x5555555555555556); | |
3dfaac44 NC |
318 | skip("All UV division is precise as NVs, so is done as NVs", 1) |
319 | if $Config{d_nv_preserves_uv}; | |
11883c88 | 320 | unlike($q, qr/[e.]/); |
5479d192 | 321 | } |
09bb3e27 | 322 | |
e2c88acc | 323 | $q = 0xFFFFFFFFFFFFFFFF % 0x5555555555555555; |
11883c88 | 324 | cmp_ok($q, '==', 0); |
e2c88acc NC |
325 | |
326 | $q = 0xFFFFFFFFFFFFFFFF % 0xFFFFFFFFFFFFFFF0; | |
11883c88 | 327 | cmp_ok($q, '==', 0xF); |
e2c88acc NC |
328 | |
329 | $q = 0x8000000000000000 % 9223372036854775807; | |
11883c88 | 330 | cmp_ok($q, '==', 1); |
e2c88acc NC |
331 | |
332 | $q = 0x8000000000000000 % -9223372036854775807; | |
11883c88 | 333 | cmp_ok($q, '==', -9223372036854775806); |
e2c88acc | 334 | |
53305cf1 | 335 | { |
11883c88 NC |
336 | use integer; |
337 | $q = hex "0x123456789abcdef0"; | |
338 | cmp_ok($q, '==', 0x123456789abcdef0); | |
339 | cmp_ok($q, '!=', 0x123456789abcdef1); | |
340 | unlike($q, qr/[e.]/, 'Should not be floating point'); | |
341 | ||
342 | $q = oct "0x123456789abcdef0"; | |
343 | cmp_ok($q, '==', 0x123456789abcdef0); | |
344 | cmp_ok($q, '!=', 0x123456789abcdef1); | |
345 | unlike($q, qr/[e.]/, 'Should not be floating point'); | |
346 | ||
347 | $q = oct "765432176543217654321"; | |
348 | cmp_ok($q, '==', 0765432176543217654321); | |
349 | cmp_ok($q, '!=', 0765432176543217654322); | |
350 | unlike($q, qr/[e.]/, 'Should not be floating point'); | |
351 | ||
352 | $q = oct "0b0101010101010101010101010101010101010101010101010101010101010101"; | |
353 | cmp_ok($q, '==', 0x5555555555555555); | |
354 | cmp_ok($q, '!=', 0x5555555555555556); | |
355 | unlike($q, qr/[e.]/, 'Should not be floating point'); | |
53305cf1 NC |
356 | } |
357 | ||
11883c88 | 358 | done_testing(); |