xref: /openbsd/gnu/usr.bin/perl/t/op/64bitint.t (revision 73471bf0) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7    eval { my $q = pack "q", 0 };
8    skip_all('no 64-bit types') if $@;
9}
10
11# This could use many more tests.
12
13# so that using > 0xfffffff constants and
14# 32+ bit integers don't cause noise
15use warnings;
16no warnings qw(overflow portable);
17use Config;
18
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
34my $q = 12345678901;
35my $r = 23456789012;
36my $f = 0xffffffff;
37my $x;
38my $y;
39
40$x = unpack "q", pack "q", $q;
41cmp_ok($x, '==', $q);
42cmp_ok($x, '>', $f);
43
44
45$x = sprintf("%lld", 12345678901);
46is($x, $q);
47cmp_ok($x, '>', $f);
48
49$x = sprintf("%lld", $q);
50cmp_ok($x, '==', $q);
51is($x, $q);
52cmp_ok($x, '>', $f);
53
54$x = sprintf("%Ld", $q);
55cmp_ok($x, '==', $q);
56is($x, $q);
57cmp_ok($x, '>', $f);
58
59$x = sprintf("%qd", $q);
60cmp_ok($x, '==', $q);
61is($x, $q);
62cmp_ok($x, '>', $f);
63
64
65$x = sprintf("%llx", $q);
66cmp_ok(hex $x, '==', 0x2dfdc1c35);
67cmp_ok(hex $x, '>', $f);
68
69$x = sprintf("%Lx", $q);
70cmp_ok(hex $x, '==', 0x2dfdc1c35);
71cmp_ok(hex $x, '>', $f);
72
73$x = sprintf("%qx", $q);
74cmp_ok(hex $x, '==', 0x2dfdc1c35);
75cmp_ok(hex $x, '>', $f);
76
77$x = sprintf("%llo", $q);
78cmp_ok(oct "0$x", '==', 0133767016065);
79cmp_ok(oct $x, '>', $f);
80
81$x = sprintf("%Lo", $q);
82cmp_ok(oct "0$x", '==', 0133767016065);
83cmp_ok(oct $x, '>', $f);
84
85$x = sprintf("%qo", $q);
86cmp_ok(oct "0$x", '==', 0133767016065);
87cmp_ok(oct $x, '>', $f);
88
89$x = sprintf("%llb", $q);
90cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
91cmp_ok(oct "0b$x", '>', $f);
92
93$x = sprintf("%Lb", $q);
94cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
95cmp_ok(oct "0b$x", '>', $f);
96
97$x = sprintf("%qb", $q);
98cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
99cmp_ok(oct "0b$x", '>', $f);
100
101
102$x = sprintf("%llu", $q);
103is($x, $q);
104cmp_ok($x, '>', $f);
105
106$x = sprintf("%Lu", $q);
107cmp_ok($x, '==', $q);
108is($x, $q);
109cmp_ok($x, '>', $f);
110
111$x = sprintf("%qu", $q);
112cmp_ok($x, '==', $q);
113is($x, $q);
114cmp_ok($x, '>', $f);
115
116
117$x = sprintf("%D", $q);
118cmp_ok($x, '==', $q);
119is($x, $q);
120cmp_ok($x, '>', $f);
121
122$x = sprintf("%U", $q);
123cmp_ok($x, '==', $q);
124is($x, $q);
125cmp_ok($x, '>', $f);
126
127$x = sprintf("%O", $q);
128cmp_ok(oct $x, '==', $q);
129cmp_ok(oct $x, '>', $f);
130
131
132$x = $q + $r;
133cmp_ok($x, '==', 35802467913);
134cmp_ok($x, '>', $f);
135
136$x = $q - $r;
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';
145
146    $x = $q * 1234567;
147    cmp_ok($x, '==', 15241567763770867);
148    cmp_ok($x, '>', $f);
149
150    $x /= 1234567;
151    cmp_ok($x, '==', $q);
152    cmp_ok($x, '>', $f);
153
154    $x = 98765432109 % 12345678901;
155    cmp_ok($x, '==', 901);
156
157    # The following 12 tests adapted from op/inc.
158
159    $a = 9223372036854775807;
160    $c = $a++;
161    cmp_ok($a, '==', 9223372036854775808);
162
163    $a = 9223372036854775807;
164    $c = ++$a;
165    cmp_ok($a, '==', 9223372036854775808);
166    cmp_ok($c, '==', $a);
167
168    $a = 9223372036854775807;
169    $c = $a + 1;
170    cmp_ok($a, '==', 9223372036854775807);
171    cmp_ok($c, '==', 9223372036854775808);
172
173    $a = -9223372036854775808;
174    {
175	no warnings 'imprecision';
176	$c = $a--;
177    }
178    cmp_ok($a, '==', -9223372036854775809);
179    cmp_ok($c, '==', -9223372036854775808);
180
181    $a = -9223372036854775808;
182    {
183	no warnings 'imprecision';
184	$c = --$a;
185    }
186    cmp_ok($a, '==', -9223372036854775809);
187    cmp_ok($c, '==', $a);
188
189    $a = -9223372036854775808;
190    $c = $a - 1;
191    cmp_ok($a, '==', -9223372036854775808);
192    cmp_ok($c, '==', -9223372036854775809);
193
194    $a = 9223372036854775808;
195    $a = -$a;
196    {
197	no warnings 'imprecision';
198	$c = $a--;
199    }
200    cmp_ok($a, '==', -9223372036854775809);
201    cmp_ok($c, '==', -9223372036854775808);
202
203    $a = 9223372036854775808;
204    $a = -$a;
205    {
206	no warnings 'imprecision';
207	$c = --$a;
208    }
209    cmp_ok($a, '==', -9223372036854775809);
210    cmp_ok($c, '==', $a);
211
212    $a = 9223372036854775808;
213    $a = -$a;
214    $c = $a - 1;
215    cmp_ok($a, '==', -9223372036854775808);
216    cmp_ok($c, '==', -9223372036854775809);
217
218    $a = 9223372036854775808;
219    $b = -$a;
220    {
221	no warnings 'imprecision';
222	$c = $b--;
223    }
224    cmp_ok($b, '==', -$a-1);
225    cmp_ok($c, '==', -$a);
226
227    $a = 9223372036854775808;
228    $b = -$a;
229    {
230	no warnings 'imprecision';
231	$c = --$b;
232    }
233    cmp_ok($b, '==', -$a-1);
234    cmp_ok($c, '==', $b);
235
236    $a = 9223372036854775808;
237    $b = -$a;
238    $b = $b - 1;
239    cmp_ok($b, '==', -(++$a));
240}
241
242
243$x = '';
244cmp_ok((vec($x, 1, 64) = $q), '==', $q);
245
246cmp_ok(vec($x, 1, 64), '==', $q);
247cmp_ok(vec($x, 1, 64), '>', $f);
248
249cmp_ok(vec($x, 0, 64), '==', 0);
250cmp_ok(vec($x, 2, 64), '==', 0);
251
252cmp_ok(~0, '==', 0xffffffffffffffff);
253
254cmp_ok((0xffffffff<<32), '==', 0xffffffff00000000);
255
256cmp_ok(((0xffffffff)<<32)>>32, '==', 0xffffffff);
257
258cmp_ok(1<<63, '==', 0x8000000000000000);
259
260is((sprintf "%#Vx", 1<<63), '0x8000000000000000');
261
262cmp_ok((0x8000000000000000 | 1), '==', 0x8000000000000001);
263
264cmp_ok((0xf000000000000000 & 0x8000000000000000), '==', 0x8000000000000000);
265cmp_ok((0xf000000000000000 ^ 0xfffffffffffffff0), '==', 0x0ffffffffffffff0);
266
267
268is((sprintf "%b", ~0),
269   '1111111111111111111111111111111111111111111111111111111111111111');
270
271
272is((sprintf "%64b", ~0),
273   '1111111111111111111111111111111111111111111111111111111111111111');
274
275is((sprintf "%d", ~0>>1),'9223372036854775807');
276is((sprintf "%u", ~0),'18446744073709551615');
277
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;
282is("$q","-9223372036854775808");
283
284$q =  9223372036854775807;
285is("$q","9223372036854775807");
286
287$q = 18446744073709551615;
288is("$q","18446744073709551615");
289
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}
299is($num, $string);
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;
306is($num, $string);
307
308$q = "18446744073709551616e0";
309$q += 0;
310isnt($q, "18446744073709551615");
311
312# 0xFFFFFFFFFFFFFFFF ==  1 * 3 * 5 * 17 * 257 * 641 * 65537 * 6700417'
313$q = 0xFFFFFFFFFFFFFFFF / 3;
314cmp_ok($q, '==', 0x5555555555555555);
315SKIP: {
316    skip("Maths does not preserve UVs", 2) unless $maths_preserves_UVs;
317    cmp_ok($q, '!=', 0x5555555555555556);
318    skip("All UV division is precise as NVs, so is done as NVs", 1)
319	if $Config{d_nv_preserves_uv};
320    unlike($q, qr/[e.]/);
321}
322
323$q = 0xFFFFFFFFFFFFFFFF % 0x5555555555555555;
324cmp_ok($q, '==', 0);
325
326$q = 0xFFFFFFFFFFFFFFFF % 0xFFFFFFFFFFFFFFF0;
327cmp_ok($q, '==', 0xF);
328
329$q = 0x8000000000000000 % 9223372036854775807;
330cmp_ok($q, '==', 1);
331
332$q = 0x8000000000000000 % -9223372036854775807;
333cmp_ok($q, '==', -9223372036854775806);
334
335{
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');
356}
357
358# trigger various attempts to negate IV_MIN
359
360cmp_ok  0x8000000000000000 / -0x8000000000000000, '==', -1, '(IV_MAX+1) / IV_MIN';
361cmp_ok -0x8000000000000000 /  0x8000000000000000, '==', -1, 'IV_MIN / (IV_MAX+1)';
362cmp_ok  0x8000000000000000 / -1, '==', -0x8000000000000000, '(IV_MAX+1) / -1';
363cmp_ok                   0 % -0x8000000000000000, '==',  0, '0 % IV_MIN';
364cmp_ok -0x8000000000000000 % -0x8000000000000000, '==',  0, 'IV_MIN % IV_MIN';
365
366# check addition/subtraction with values 1 bit below max ranges
367{
368    my $a_3ff = 0x3fffffffffffffff;
369    my $a_400 = 0x4000000000000000;
370    my $a_7fe = 0x7ffffffffffffffe;
371    my $a_7ff = 0x7fffffffffffffff;
372    my $a_800 = 0x8000000000000000;
373
374    my $m_3ff = -$a_3ff;
375    my $m_400 = -$a_400;
376    my $m_7fe = -$a_7fe;
377    my $m_7ff = -$a_7ff;
378
379    cmp_ok $a_3ff, '==',  4611686018427387903, "1bit  a_3ff";
380    cmp_ok $m_3ff, '==', -4611686018427387903, "1bit -a_3ff";
381    cmp_ok $a_400, '==',  4611686018427387904, "1bit  a_400";
382    cmp_ok $m_400, '==', -4611686018427387904, "1bit -a_400";
383    cmp_ok $a_7fe, '==',  9223372036854775806, "1bit  a_7fe";
384    cmp_ok $m_7fe, '==', -9223372036854775806, "1bit -a_7fe";
385    cmp_ok $a_7ff, '==',  9223372036854775807, "1bit  a_7ff";
386    cmp_ok $m_7ff, '==', -9223372036854775807, "1bit -a_7ff";
387    cmp_ok $a_800, '==',  9223372036854775808, "1bit  a_800";
388
389    cmp_ok $a_3ff + $a_3ff, '==',  $a_7fe, "1bit  a_3ff +  a_3ff";
390    cmp_ok $m_3ff + $a_3ff, '==',       0, "1bit -a_3ff +  a_3ff";
391    cmp_ok $a_3ff + $m_3ff, '==',       0, "1bit  a_3ff + -a_3ff";
392    cmp_ok $m_3ff + $m_3ff, '==',  $m_7fe, "1bit -a_3ff + -a_3ff";
393
394    cmp_ok $a_3ff - $a_3ff, '==',       0, "1bit  a_3ff -  a_3ff";
395    cmp_ok $m_3ff - $a_3ff, '==',  $m_7fe, "1bit -a_3ff -  a_3ff";
396    cmp_ok $a_3ff - $m_3ff, '==',  $a_7fe, "1bit  a_3ff - -a_3ff";
397    cmp_ok $m_3ff - $m_3ff, '==',       0, "1bit -a_3ff - -a_3ff";
398
399    cmp_ok $a_3ff + $a_400, '==',  $a_7ff, "1bit  a_3ff +  a_400";
400    cmp_ok $m_3ff + $a_400, '==',       1, "1bit -a_3ff +  a_400";
401    cmp_ok $a_3ff + $m_400, '==',      -1, "1bit  a_3ff + -a_400";
402    cmp_ok $m_3ff + $m_400, '==',  $m_7ff, "1bit -a_3ff + -a_400";
403
404    cmp_ok $a_3ff - $a_400, '==',      -1, "1bit  a_3ff -  a_400";
405    cmp_ok $m_3ff - $a_400, '==',  $m_7ff, "1bit -a_3ff -  a_400";
406    cmp_ok $a_3ff - $m_400, '==',  $a_7ff, "1bit  a_3ff - -a_400";
407    cmp_ok $m_3ff - $m_400, '==',       1, "1bit -a_3ff - -a_400";
408
409    cmp_ok $a_400 + $a_3ff, '==',  $a_7ff, "1bit  a_400 +  a_3ff";
410    cmp_ok $m_400 + $a_3ff, '==',      -1, "1bit -a_400 +  a_3ff";
411    cmp_ok $a_400 + $m_3ff, '==',       1, "1bit  a_400 + -a_3ff";
412    cmp_ok $m_400 + $m_3ff, '==',  $m_7ff, "1bit -a_400 + -a_3ff";
413
414    cmp_ok $a_400 - $a_3ff, '==',       1, "1bit  a_400 -  a_3ff";
415    cmp_ok $m_400 - $a_3ff, '==',  $m_7ff, "1bit -a_400 -  a_3ff";
416    cmp_ok $a_400 - $m_3ff, '==',  $a_7ff, "1bit  a_400 - -a_3ff";
417    cmp_ok $m_400 - $m_3ff, '==',      -1, "1bit -a_400 - -a_3ff";
418}
419
420# check multiplication with values using approx half the total bits
421{
422    my $a  =         0xffffffff;
423    my $aa = 0xfffffffe00000001;
424    my $m  = -$a;
425    my $mm = -$aa;
426
427    cmp_ok $a,      '==',            4294967295, "halfbits   a";
428    cmp_ok $m,      '==',           -4294967295, "halfbits  -a";
429    cmp_ok $aa,     '==',  18446744065119617025, "halfbits  aa";
430    cmp_ok $mm,     '==', -18446744065119617025, "halfbits -aa";
431    cmp_ok $a * $a, '==',                   $aa, "halfbits  a *  a";
432    cmp_ok $m * $a, '==',                   $mm, "halfbits -a *  a";
433    cmp_ok $a * $m, '==',                   $mm, "halfbits  a * -a";
434    cmp_ok $m * $m, '==',                   $aa, "halfbits -a * -a";
435}
436
437# check multiplication where the 2 args multiply to 2^62 .. 2^65
438
439{
440    my $exp62 = (2**62);
441    my $exp63 = (2**63);
442    my $exp64 = (2**64);
443    my $exp65 = (2**65);
444    cmp_ok $exp62, '==',  4611686018427387904, "2**62";
445    cmp_ok $exp63, '==',  9223372036854775808, "2**63";
446    cmp_ok $exp64, '==', 18446744073709551616, "2**64";
447    cmp_ok $exp65, '==', 36893488147419103232, "2**65";
448
449    my @exp = ($exp62, $exp63, $exp64, $exp65);
450    for my $i (0..63) {
451        for my $x (0..3) {
452            my $j = 62 - $i + $x;
453            next if $j < 0 or $j > 63;
454
455            my $a = (1 << $i);
456            my $b = (1 << $j);
457            my $c = $a * $b;
458            cmp_ok $c, '==', $exp[$x], "(1<<$i) * (1<<$j)";
459        }
460    }
461}
462
463done_testing();
464