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