| 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 calcualtion 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're at it |
| 41 | is(-3**0, -1); |
| 42 | is(-3**1, -3); |
| 43 | is(-3**2, -9); |
| 44 | is(-3**3, -27); |
| 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 | } |