This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
11883c88c2a3bf14 introduced an error in 64bitint.t with long doubles.
[perl5.git] / t / op / 64bitint.t
CommitLineData
11883c88 1#!./perl
e312add1 2
0f4b6630 3BEGIN {
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 15use warnings;
4438c4b7 16no warnings qw(overflow portable);
3dfaac44 17use 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
23my $UV_max = ~0;
24die "UV_max eq '$UV_max', doesn't end in 5; your UV isn't 4n bits long :-(."
25 unless $UV_max =~ /5$/;
26my $UV_max_less3 = $UV_max - 3;
27my $maths_preserves_UVs = $UV_max_less3 =~ /^\d+2$/; # 5 - 3 is 2.
28if ($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
34my $q = 12345678901;
35my $r = 23456789012;
20fe1ea2 36my $f = 0xffffffff;
0f4b6630 37my $x;
2d4389e4 38my $y;
0f4b6630
JH
39
40$x = unpack "q", pack "q", $q;
11883c88
NC
41cmp_ok($x, '==', $q);
42cmp_ok($x, '>', $f);
0f4b6630
JH
43
44
22f3ae8c 45$x = sprintf("%lld", 12345678901);
11883c88
NC
46is($x, $q);
47cmp_ok($x, '>', $f);
0f4b6630 48
0f4b6630 49$x = sprintf("%lld", $q);
11883c88
NC
50cmp_ok($x, '==', $q);
51is($x, $q);
52cmp_ok($x, '>', $f);
0f4b6630
JH
53
54$x = sprintf("%Ld", $q);
11883c88
NC
55cmp_ok($x, '==', $q);
56is($x, $q);
57cmp_ok($x, '>', $f);
0f4b6630
JH
58
59$x = sprintf("%qd", $q);
11883c88
NC
60cmp_ok($x, '==', $q);
61is($x, $q);
62cmp_ok($x, '>', $f);
0f4b6630 63
0f4b6630
JH
64
65$x = sprintf("%llx", $q);
11883c88
NC
66cmp_ok(hex $x, '==', 0x2dfdc1c35);
67cmp_ok(hex $x, '>', $f);
0f4b6630
JH
68
69$x = sprintf("%Lx", $q);
11883c88
NC
70cmp_ok(hex $x, '==', 0x2dfdc1c35);
71cmp_ok(hex $x, '>', $f);
0f4b6630
JH
72
73$x = sprintf("%qx", $q);
11883c88
NC
74cmp_ok(hex $x, '==', 0x2dfdc1c35);
75cmp_ok(hex $x, '>', $f);
0f4b6630
JH
76
77$x = sprintf("%llo", $q);
11883c88
NC
78cmp_ok(oct "0$x", '==', 0133767016065);
79cmp_ok(oct $x, '>', $f);
0f4b6630
JH
80
81$x = sprintf("%Lo", $q);
11883c88
NC
82cmp_ok(oct "0$x", '==', 0133767016065);
83cmp_ok(oct $x, '>', $f);
0f4b6630
JH
84
85$x = sprintf("%qo", $q);
11883c88
NC
86cmp_ok(oct "0$x", '==', 0133767016065);
87cmp_ok(oct $x, '>', $f);
0f4b6630
JH
88
89$x = sprintf("%llb", $q);
11883c88
NC
90cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
91cmp_ok(oct "0b$x", '>', $f);
0f4b6630
JH
92
93$x = sprintf("%Lb", $q);
11883c88
NC
94cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
95cmp_ok(oct "0b$x", '>', $f);
0f4b6630
JH
96
97$x = sprintf("%qb", $q);
11883c88
NC
98cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
99cmp_ok(oct "0b$x", '>', $f);
0f4b6630
JH
100
101
22f3ae8c 102$x = sprintf("%llu", $q);
11883c88
NC
103is($x, $q);
104cmp_ok($x, '>', $f);
0f4b6630 105
22f3ae8c 106$x = sprintf("%Lu", $q);
11883c88
NC
107cmp_ok($x, '==', $q);
108is($x, $q);
109cmp_ok($x, '>', $f);
0f4b6630 110
22f3ae8c 111$x = sprintf("%qu", $q);
11883c88
NC
112cmp_ok($x, '==', $q);
113is($x, $q);
114cmp_ok($x, '>', $f);
0f4b6630
JH
115
116
29fe7a80 117$x = sprintf("%D", $q);
11883c88
NC
118cmp_ok($x, '==', $q);
119is($x, $q);
120cmp_ok($x, '>', $f);
29fe7a80
JH
121
122$x = sprintf("%U", $q);
11883c88
NC
123cmp_ok($x, '==', $q);
124is($x, $q);
125cmp_ok($x, '>', $f);
29fe7a80
JH
126
127$x = sprintf("%O", $q);
11883c88
NC
128cmp_ok(oct $x, '==', $q);
129cmp_ok(oct $x, '>', $f);
29fe7a80
JH
130
131
0f4b6630 132$x = $q + $r;
11883c88
NC
133cmp_ok($x, '==', 35802467913);
134cmp_ok($x, '>', $f);
0f4b6630
JH
135
136$x = $q - $r;
11883c88
NC
137cmp_ok($x, '==', -11111110111);
138cmp_ok(-$x, '>', $f);
139
140SKIP: {
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 244cmp_ok((vec($x, 1, 64) = $q), '==', $q);
c5a0f51a 245
11883c88
NC
246cmp_ok(vec($x, 1, 64), '==', $q);
247cmp_ok(vec($x, 1, 64), '>', $f);
972b05a9 248
11883c88
NC
249cmp_ok(vec($x, 0, 64), '==', 0);
250cmp_ok(vec($x, 2, 64), '==', 0);
972b05a9 251
11883c88 252cmp_ok(~0, '==', 0xffffffffffffffff);
972b05a9 253
11883c88 254cmp_ok((0xffffffff<<32), '==', 0xffffffff00000000);
972b05a9 255
11883c88 256cmp_ok(((0xffffffff)<<32)>>32, '==', 0xffffffff);
972b05a9 257
11883c88 258cmp_ok(1<<63, '==', 0x8000000000000000);
972b05a9 259
11883c88 260is((sprintf "%#Vx", 1<<63), '0x8000000000000000');
972b05a9 261
11883c88 262cmp_ok((0x8000000000000000 | 1), '==', 0x8000000000000001);
972b05a9 263
11883c88
NC
264cmp_ok((0xf000000000000000 & 0x8000000000000000), '==', 0x8000000000000000);
265cmp_ok((0xf000000000000000 ^ 0xfffffffffffffff0), '==', 0x0ffffffffffffff0);
972b05a9 266
686fa4bb 267
11883c88
NC
268is((sprintf "%b", ~0),
269 '1111111111111111111111111111111111111111111111111111111111111111');
686fa4bb 270
686fa4bb 271
11883c88
NC
272is((sprintf "%64b", ~0),
273 '1111111111111111111111111111111111111111111111111111111111111111');
686fa4bb 274
11883c88
NC
275is((sprintf "%d", ~0>>1),'9223372036854775807');
276is((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 282is("$q","-9223372036854775808");
868d6b85
JH
283
284$q = 9223372036854775807;
11883c88 285is("$q","9223372036854775807");
868d6b85
JH
286
287$q = 18446744073709551615;
11883c88 288is("$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.
292my $num = 4294967297;
293my $string = "4294967297";
294{
295 use integer;
296 $num += 0;
297 $string += 0;
298}
11883c88 299is($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 306is($num, $string);
85b81d93 307
09bb3e27
NC
308$q = "18446744073709551616e0";
309$q += 0;
11883c88 310isnt($q, "18446744073709551615");
09bb3e27 311
5479d192
NC
312# 0xFFFFFFFFFFFFFFFF == 1 * 3 * 5 * 17 * 257 * 641 * 65537 * 6700417'
313$q = 0xFFFFFFFFFFFFFFFF / 3;
11883c88
NC
314cmp_ok($q, '==', 0x5555555555555555);
315SKIP: {
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 324cmp_ok($q, '==', 0);
e2c88acc
NC
325
326$q = 0xFFFFFFFFFFFFFFFF % 0xFFFFFFFFFFFFFFF0;
11883c88 327cmp_ok($q, '==', 0xF);
e2c88acc
NC
328
329$q = 0x8000000000000000 % 9223372036854775807;
11883c88 330cmp_ok($q, '==', 1);
e2c88acc
NC
331
332$q = 0x8000000000000000 % -9223372036854775807;
11883c88 333cmp_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 358done_testing();