xref: /openbsd/gnu/usr.bin/perl/t/op/64bitint.t (revision 78b63d65)
1#./perl
2
3BEGIN {
4	eval { my $q = pack "q", 0 };
5	if ($@) {
6		print "1..0\n# Skip: no 64-bit types\n";
7		exit(0);
8	}
9	chdir 't' if -d 't';
10	@INC = '../lib';
11}
12
13# This could use many more tests.
14
15# so that using > 0xfffffff constants and
16# 32+ bit integers don't cause noise
17no warnings qw(overflow portable);
18
19print "1..55\n";
20
21my $q = 12345678901;
22my $r = 23456789012;
23my $f = 0xffffffff;
24my $x;
25my $y;
26
27$x = unpack "q", pack "q", $q;
28print "not " unless $x == $q && $x > $f;
29print "ok 1\n";
30
31
32$x = sprintf("%lld", 12345678901);
33print "not " unless $x eq $q && $x > $f;
34print "ok 2\n";
35
36
37$x = sprintf("%lld", $q);
38print "not " unless $x == $q && $x eq $q && $x > $f;
39print "ok 3\n";
40
41$x = sprintf("%Ld", $q);
42print "not " unless $x == $q && $x eq $q && $x > $f;
43print "ok 4\n";
44
45$x = sprintf("%qd", $q);
46print "not " unless $x == $q && $x eq $q && $x > $f;
47print "ok 5\n";
48
49
50$x = sprintf("%llx", $q);
51print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
52print "ok 6\n";
53
54$x = sprintf("%Lx", $q);
55print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
56print "ok 7\n";
57
58$x = sprintf("%qx", $q);
59print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
60print "ok 8\n";
61
62
63$x = sprintf("%llo", $q);
64print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
65print "ok 9\n";
66
67$x = sprintf("%Lo", $q);
68print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
69print "ok 10\n";
70
71$x = sprintf("%qo", $q);
72print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
73print "ok 11\n";
74
75
76$x = sprintf("%llb", $q);
77print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
78                    oct("0b$x") > $f;
79print "ok 12\n";
80
81$x = sprintf("%Lb", $q);
82print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
83                                   oct("0b$x") > $f;
84print "ok 13\n";
85
86$x = sprintf("%qb", $q);
87print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
88                    oct("0b$x") > $f;
89print "ok 14\n";
90
91
92$x = sprintf("%llu", $q);
93print "not " unless $x eq $q && $x > $f;
94print "ok 15\n";
95
96$x = sprintf("%Lu", $q);
97print "not " unless $x == $q && $x eq $q && $x > $f;
98print "ok 16\n";
99
100$x = sprintf("%qu", $q);
101print "not " unless $x == $q && $x eq $q && $x > $f;
102print "ok 17\n";
103
104
105$x = sprintf("%D", $q);
106print "not " unless $x == $q && $x eq $q && $x > $f;
107print "ok 18\n";
108
109$x = sprintf("%U", $q);
110print "not " unless $x == $q && $x eq $q && $x > $f;
111print "ok 19\n";
112
113$x = sprintf("%O", $q);
114print "not " unless oct($x) == $q && oct($x) > $f;
115print "ok 20\n";
116
117
118$x = $q + $r;
119print "not " unless $x == 35802467913 && $x > $f;
120print "ok 21\n";
121
122$x = $q - $r;
123print "not " unless $x == -11111110111 && -$x > $f;
124print "ok 22\n";
125
126if ($^O ne 'unicos') {
127    $x = $q * 1234567;
128    print "not " unless $x == 15241567763770867 && $x > $f;
129    print "ok 23\n";
130
131    $x /= 1234567;
132    print "not " unless $x == $q && $x > $f;
133    print "ok 24\n";
134
135    $x = 98765432109 % 12345678901;
136    print "not " unless $x == 901;
137    print "ok 25\n";
138
139    # The following 12 tests adapted from op/inc.
140
141    $a = 9223372036854775807;
142    $c = $a++;
143    print "not " unless $a == 9223372036854775808;
144    print "ok 26\n";
145
146    $a = 9223372036854775807;
147    $c = ++$a;
148    print "not "
149	unless $a == 9223372036854775808 && $c == $a;
150    print "ok 27\n";
151
152    $a = 9223372036854775807;
153    $c = $a + 1;
154    print "not "
155	unless $a == 9223372036854775807 && $c == 9223372036854775808;
156    print "ok 28\n";
157
158    $a = -9223372036854775808;
159    $c = $a--;
160    print "not "
161	unless $a == -9223372036854775809 && $c == -9223372036854775808;
162    print "ok 29\n";
163
164    $a = -9223372036854775808;
165    $c = --$a;
166    print "not "
167	unless $a == -9223372036854775809 && $c == $a;
168    print "ok 30\n";
169
170    $a = -9223372036854775808;
171    $c = $a - 1;
172    print "not "
173	unless $a == -9223372036854775808 && $c == -9223372036854775809;
174    print "ok 31\n";
175
176    $a = 9223372036854775808;
177    $a = -$a;
178    $c = $a--;
179    print "not "
180	unless $a == -9223372036854775809 && $c == -9223372036854775808;
181    print "ok 32\n";
182
183    $a = 9223372036854775808;
184    $a = -$a;
185    $c = --$a;
186    print "not "
187	unless $a == -9223372036854775809 && $c == $a;
188    print "ok 33\n";
189
190    $a = 9223372036854775808;
191    $a = -$a;
192    $c = $a - 1;
193    print "not "
194	unless $a == -9223372036854775808 && $c == -9223372036854775809;
195    print "ok 34\n";
196
197    $a = 9223372036854775808;
198    $b = -$a;
199    $c = $b--;
200    print "not "
201	unless $b == -$a-1 && $c == -$a;
202    print "ok 35\n";
203
204    $a = 9223372036854775808;
205    $b = -$a;
206    $c = --$b;
207    print "not "
208	unless $b == -$a-1 && $c == $b;
209    print "ok 36\n";
210
211    $a = 9223372036854775808;
212    $b = -$a;
213    $b = $b - 1;
214    print "not "
215	unless $b == -(++$a);
216    print "ok 37\n";
217
218} else {
219    # Unicos has imprecise doubles (14 decimal digits or so),
220    # especially if operating near the UV/IV limits the low-order bits
221    # become mangled even by simple arithmetic operations.
222    for (23..37) {
223	print "ok $_ # skipped: too imprecise numbers\n";
224    }
225}
226
227
228$x = '';
229print "not " unless (vec($x, 1, 64) = $q) == $q;
230print "ok 38\n";
231
232print "not " unless vec($x, 1, 64) == $q && vec($x, 1, 64) > $f;
233print "ok 39\n";
234
235print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0;
236print "ok 40\n";
237
238
239print "not " unless ~0 == 0xffffffffffffffff;
240print "ok 41\n";
241
242print "not " unless (0xffffffff<<32) == 0xffffffff00000000;
243print "ok 42\n";
244
245print "not " unless ((0xffffffff)<<32)>>32 == 0xffffffff;
246print "ok 43\n";
247
248print "not " unless 1<<63 == 0x8000000000000000;
249print "ok 44\n";
250
251print "not " unless (sprintf "%#Vx", 1<<63) eq '0x8000000000000000';
252print "ok 45\n";
253
254print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001;
255print "ok 46\n";
256
257print "not "
258    unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000;
259print "ok 47\n";
260
261print "not "
262    unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0;
263print "ok 48\n";
264
265
266print "not "
267    unless (sprintf "%b", ~0)   eq
268           '1111111111111111111111111111111111111111111111111111111111111111';
269print "ok 49\n";
270
271print "not "
272    unless (sprintf "%64b", ~0) eq
273           '1111111111111111111111111111111111111111111111111111111111111111';
274print "ok 50\n";
275
276print "not " unless (sprintf "%d", ~0>>1) eq '9223372036854775807';
277print "ok 51\n";
278
279print "not " unless (sprintf "%u", ~0)    eq '18446744073709551615';
280print "ok 52\n";
281
282# If the 53..55 fail you have problems in the parser's string->int conversion,
283# see toke.c:scan_num().
284
285$q = -9223372036854775808;
286print "# $q ne\n# -9223372036854775808\nnot " unless "$q" eq "-9223372036854775808";
287print "ok 53\n";
288
289$q =  9223372036854775807;
290print "# $q ne\n# 9223372036854775807\nnot " unless "$q" eq "9223372036854775807";
291print "ok 54\n";
292
293$q = 18446744073709551615;
294print "# $q ne\n# 18446744073709551615\nnot " unless "$q" eq "18446744073709551615";
295print "ok 55\n";
296
297# eof
298