t/op/pow.t

   1 #!./perl -w
   2 # Now they'll be wanting biff! and zap! tests too.
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7     require './test.pl';
   8 }
   9
  10 # This calculation ought to be within 0.001 of the right answer.
  11 my $bits_in_uv = int (0.001 + log (~0+1) / log 2);
  12
  13 # 3**30 < 2**48, don't trust things outside that range on a Cray
  14 # Likewise other 3 should not overflow 48 bits if I did my sums right.
  15 my @pow = ([  3, 30, 1e-14],
  16            [  4, 32,     0],
  17            [  5, 20, 1e-14],
  18            [2.5, 10, 1e-14],
  19            [ -2, 69,     0],
  20            [ -3, 30, 1e-14],
  21 );
  22 my $tests;
  23 $tests += $_->[1] foreach @pow;
  24
  25 plan tests => 13 + $bits_in_uv + $tests;
  26
  27 # (-3)**3 gave 27 instead of -27 before change #20167.
  28 # Let's test the other similar edge cases, too.
  29 is((-3)**0, 1,   "negative ** 0 = 1");
  30 is((-3)**1, -3,  "negative ** 1 = self");
  31 is((-3)**2, 9,   "negative ** 2 = positive");
  32 is((-3)**3, -27, "(negative int) ** (odd power) is negative");
  33
  34 # Positives shouldn't be a problem
  35 is(3**0, 1,      "positive ** 0 = 1");
  36 is(3**1, 3,      "positive ** 1 = self");
  37 is(3**2, 9,      "positive ** 2 = positive");
  38 is(3**3, 27,     "(positive int) ** (odd power) is positive");
  39
  40 # And test order of operations while we are at it
  41 is(-3**0, -1,      "positive ** 0, then negated, = -1");
  42 is(-3**1, -3,      "positive ** 1, then negated, = negative of self");
  43 is(-3**2, -9,      "positive ** 2, then negated, = negative of square");
  44 is(-3**3, -27,     "(positive int) ** (odd power), then negated, is negative");
  45
  46
  47 # Ought to be 32, 64, 36 or something like that.
  48
  49 my $remainder = $bits_in_uv & 3;
  50
  51 cmp_ok ($remainder, '==', 0, 'Sanity check bits in UV calculation')
  52     or printf "# ~0 is %d (0x%d) which gives $bits_in_uv bits\n", ~0, ~0;
  53
  54 # These are a lot of brute force tests to see how accurate $m ** $n is.
  55 # Unfortunately rather a lot of perl programs expect 2 ** $n to be integer
  56 # perfect, forgetting that it's a call to floating point pow() which never
  57 # claims to deliver perfection.
  58 foreach my $n (0..$bits_in_uv - 1) {
  59     my $pow = 2 ** $n;
  60     my $int = 1 << $n;
  61     cmp_ok ($pow, '==', $int, "2 ** $n vs 1 << $n");
  62 }
  63
  64 foreach my $pow (@pow) {
  65     my ($base, $max, $range) = @$pow;
  66     my $expect = 1;
  67     foreach my $n (0..$max-1) {
  68         my $got = $base ** $n;
  69         within ($got, $expect, $range, "$base ** $n got[$got] expect[$expect]");
  70         $expect *= $base;
  71     }
  72 }