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