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 use 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
  23 my $UV_max = ~0;
  24 die "UV_max eq '$UV_max', doesn't end in 5; your UV isn't 4n bits long :-(."
  25   unless $UV_max =~ /5$/;
  26 my $UV_max_less3 = $UV_max - 3;
  27 my $maths_preserves_UVs = $UV_max_less3 =~ /^\d+2$/;   # 5 - 3 is 2.
  28 if ($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
  34 my $q = 12345678901;
  35 my $r = 23456789012;
  36 my $f = 0xffffffff;
  37 my $x;
  38 my $y;
  39
  40 $x = unpack "q", pack "q", $q;
  41 cmp_ok($x, '==', $q);
  42 cmp_ok($x, '>', $f);
  43
  44
  45 $x = sprintf("%lld", 12345678901);
  46 is($x, $q);
  47 cmp_ok($x, '>', $f);
  48
  49 $x = sprintf("%lld", $q);
  50 cmp_ok($x, '==', $q);
  51 is($x, $q);
  52 cmp_ok($x, '>', $f);
  53
  54 $x = sprintf("%Ld", $q);
  55 cmp_ok($x, '==', $q);
  56 is($x, $q);
  57 cmp_ok($x, '>', $f);
  58
  59 $x = sprintf("%qd", $q);
  60 cmp_ok($x, '==', $q);
  61 is($x, $q);
  62 cmp_ok($x, '>', $f);
  63
  64
  65 $x = sprintf("%llx", $q);
  66 cmp_ok(hex $x, '==', 0x2dfdc1c35);
  67 cmp_ok(hex $x, '>', $f);
  68
  69 $x = sprintf("%Lx", $q);
  70 cmp_ok(hex $x, '==', 0x2dfdc1c35);
  71 cmp_ok(hex $x, '>', $f);
  72
  73 $x = sprintf("%qx", $q);
  74 cmp_ok(hex $x, '==', 0x2dfdc1c35);
  75 cmp_ok(hex $x, '>', $f);
  76
  77 $x = sprintf("%llo", $q);
  78 cmp_ok(oct "0$x", '==', 0133767016065);
  79 cmp_ok(oct $x, '>', $f);
  80
  81 $x = sprintf("%Lo", $q);
  82 cmp_ok(oct "0$x", '==', 0133767016065);
  83 cmp_ok(oct $x, '>', $f);
  84
  85 $x = sprintf("%qo", $q);
  86 cmp_ok(oct "0$x", '==', 0133767016065);
  87 cmp_ok(oct $x, '>', $f);
  88
  89 $x = sprintf("%llb", $q);
  90 cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
  91 cmp_ok(oct "0b$x", '>', $f);
  92
  93 $x = sprintf("%Lb", $q);
  94 cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
  95 cmp_ok(oct "0b$x", '>', $f);
  96
  97 $x = sprintf("%qb", $q);
  98 cmp_ok(oct "0b$x", '==', 0b1011011111110111000001110000110101);
  99 cmp_ok(oct "0b$x", '>', $f);
 100
 101
 102 $x = sprintf("%llu", $q);
 103 is($x, $q);
 104 cmp_ok($x, '>', $f);
 105
 106 $x = sprintf("%Lu", $q);
 107 cmp_ok($x, '==', $q);
 108 is($x, $q);
 109 cmp_ok($x, '>', $f);
 110
 111 $x = sprintf("%qu", $q);
 112 cmp_ok($x, '==', $q);
 113 is($x, $q);
 114 cmp_ok($x, '>', $f);
 115
 116
 117 $x = sprintf("%D", $q);
 118 cmp_ok($x, '==', $q);
 119 is($x, $q);
 120 cmp_ok($x, '>', $f);
 121
 122 $x = sprintf("%U", $q);
 123 cmp_ok($x, '==', $q);
 124 is($x, $q);
 125 cmp_ok($x, '>', $f);
 126
 127 $x = sprintf("%O", $q);
 128 cmp_ok(oct $x, '==', $q);
 129 cmp_ok(oct $x, '>', $f);
 130
 131
 132 $x = $q + $r;
 133 cmp_ok($x, '==', 35802467913);
 134 cmp_ok($x, '>', $f);
 135
 136 $x = $q - $r;
 137 cmp_ok($x, '==', -11111110111);
 138 cmp_ok(-$x, '>', $f);
 139
 140 SKIP: {
 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 = '';
 244 cmp_ok((vec($x, 1, 64) = $q), '==', $q);
 245
 246 cmp_ok(vec($x, 1, 64), '==', $q);
 247 cmp_ok(vec($x, 1, 64), '>', $f);
 248
 249 cmp_ok(vec($x, 0, 64), '==', 0);
 250 cmp_ok(vec($x, 2, 64), '==', 0);
 251
 252 cmp_ok(~0, '==', 0xffffffffffffffff);
 253
 254 cmp_ok((0xffffffff<<32), '==', 0xffffffff00000000);
 255
 256 cmp_ok(((0xffffffff)<<32)>>32, '==', 0xffffffff);
 257
 258 cmp_ok(1<<63, '==', 0x8000000000000000);
 259
 260 is((sprintf "%#Vx", 1<<63), '0x8000000000000000');
 261
 262 cmp_ok((0x8000000000000000 | 1), '==', 0x8000000000000001);
 263
 264 cmp_ok((0xf000000000000000 & 0x8000000000000000), '==', 0x8000000000000000);
 265 cmp_ok((0xf000000000000000 ^ 0xfffffffffffffff0), '==', 0x0ffffffffffffff0);
 266
 267
 268 is((sprintf "%b", ~0),
 269    '1111111111111111111111111111111111111111111111111111111111111111');
 270
 271
 272 is((sprintf "%64b", ~0),
 273    '1111111111111111111111111111111111111111111111111111111111111111');
 274
 275 is((sprintf "%d", ~0>>1),'9223372036854775807');
 276 is((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;
 282 is("$q","-9223372036854775808");
 283
 284 $q =  9223372036854775807;
 285 is("$q","9223372036854775807");
 286
 287 $q = 18446744073709551615;
 288 is("$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.
 292 my $num = 4294967297;
 293 my $string = "4294967297";
 294 {
 295   use integer;
 296   $num += 0;
 297   $string += 0;
 298 }
 299 is($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;
 306 is($num, $string);
 307
 308 $q = "18446744073709551616e0";
 309 $q += 0;
 310 isnt($q, "18446744073709551615");
 311
 312 # 0xFFFFFFFFFFFFFFFF ==  1 * 3 * 5 * 17 * 257 * 641 * 65537 * 6700417'
 313 $q = 0xFFFFFFFFFFFFFFFF / 3;
 314 cmp_ok($q, '==', 0x5555555555555555);
 315 SKIP: {
 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;
 324 cmp_ok($q, '==', 0);
 325
 326 $q = 0xFFFFFFFFFFFFFFFF % 0xFFFFFFFFFFFFFFF0;
 327 cmp_ok($q, '==', 0xF);
 328
 329 $q = 0x8000000000000000 % 9223372036854775807;
 330 cmp_ok($q, '==', 1);
 331
 332 $q = 0x8000000000000000 % -9223372036854775807;
 333 cmp_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 done_testing();