xref: /openbsd-src/gnu/usr.bin/perl/t/op/64bitint.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1#!./perl
2
3BEGIN {
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 $@;
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
358done_testing();
359