Commit | Line | Data |
---|---|---|
58d76dfd JH |
1 | #!./perl -w |
2 | # Now they'll be wanting biff! and zap! tests too. | |
3 | ||
4 | BEGIN { | |
5 | chdir 't' if -d 't'; | |
58d76dfd | 6 | require './test.pl'; |
624c42e2 | 7 | set_up_inc('../lib'); |
58d76dfd JH |
8 | } |
9 | ||
93f09d7b | 10 | # This calculation ought to be within 0.001 of the right answer. |
58d76dfd JH |
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. | |
f386e492 AMS |
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], | |
69ca0fd0 | 21 | ); |
58d76dfd JH |
22 | my $tests; |
23 | $tests += $_->[1] foreach @pow; | |
24 | ||
1d296f1c | 25 | plan tests => 13 + $bits_in_uv + $tests; |
0615a994 | 26 | |
1d296f1c AL |
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"); | |
0615a994 | 32 | is((-3)**3, -27, "(negative int) ** (odd power) is negative"); |
58d76dfd | 33 | |
1d296f1c AL |
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 | ||
9c5f535f JK |
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"); | |
1d296f1c AL |
45 | |
46 | ||
58d76dfd JH |
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) { | |
69ca0fd0 | 59 | my $pow = 2 ** $n; |
58d76dfd | 60 | my $int = 1 << $n; |
69ca0fd0 | 61 | cmp_ok ($pow, '==', $int, "2 ** $n vs 1 << $n"); |
58d76dfd JH |
62 | } |
63 | ||
64 | foreach my $pow (@pow) { | |
65 | my ($base, $max, $range) = @$pow; | |
69ca0fd0 | 66 | my $expect = 1; |
58d76dfd | 67 | foreach my $n (0..$max-1) { |
69ca0fd0 A |
68 | my $got = $base ** $n; |
69 | within ($got, $expect, $range, "$base ** $n got[$got] expect[$expect]"); | |
70 | $expect *= $base; | |
58d76dfd JH |
71 | } |
72 | } |