#include this file into another for subclass testing

use strict;

use warnings;

our ($CLASS, $CALC);

##############################################################################

# for testing inheritance of _swap

package Math::Foo;

use Math::BigInt lib => $main::CALC;

our @ISA = qw/Math::BigInt/;

use overload

  # customized overload for sub, since original does not use swap there

  '-'     =>      sub { my @a = ref($_[0])->_swap(@_);

                        $a[0]->bsub($a[1]);

                      };

sub _swap {

    # a fake _swap, which reverses the params

    my $self = shift;           # for override in subclass

    if ($_[2]) {

        my $c = ref($_[0]) || 'Math::Foo';

        return( $_[0]->copy(), $_[1] );

    } else {

        return( Math::Foo->new($_[1]), $_[0] );

    }

}

##############################################################################

package main;

is($CLASS->config('lib'), $CALC, "$CLASS->config('lib')");

my ($x, $y, $z, @args, $try, $got, $want);

my ($f, $round_mode, $expected_class);

while (<DATA>) {

    s/#.*$//;                   # remove comments

    s/\s+$//;                   # remove trailing whitespace

    next unless length;         # skip empty lines

    my ($m, $e);

    if (s/^&//) {

        $f = $_;

        next;

    }

    if (/^\$/) {

        $round_mode = $_;

        $round_mode =~ s/^\$/$CLASS\->/;

        next;

    }

    @args = split(/:/, $_, 99);

    $want = pop(@args);

    $expected_class = $CLASS;

    if ($want =~ /(.*?)=(.*)/) {

        $expected_class = $2;

        $want = $1;

    }

    $try = qq|\$x = $CLASS->new("$args[0]");|;

    if ($f eq "bnorm") {

        $try = qq|\$x = $CLASS->bnorm("$args[0]");|;

    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {

        $try .= " \$x->$f() || 0;";

    } elsif ($f eq "is_inf") {

        $try .= qq| \$x->is_inf("$args[1]");|;

    } elsif ($f eq "binf") {

        $try .= qq| \$x->binf("$args[1]");|;

    } elsif ($f eq "bone") {

        $try .= qq| \$x->bone("$args[1]");|;

    # some unary ops

    } elsif ($f =~ /^b(nan|floor|ceil|int|sstr|neg|abs|sgn|inc|dec|not|sqrt|fac)$/) {

        $try .= " \$x->$f();";

    # overloaded functions

    } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) {

        $try .= " \$x = $f(\$x);";

    } elsif ($f =~ /^(numify|length|stringify)$/) {

        $try .= " \$x->$f();";

    } elsif ($f =~ /^(to|as)_(hex|oct|bin)$/) {

        $try .= " \$x->$f();";

    } elsif ($f eq "exponent") {

        # ->bstr() to see if an object is returned

        $try .= ' $x = $x->exponent()->bstr();';

    } elsif ($f eq "mantissa") {

        # ->bstr() to see if an object is returned

        $try .= ' $x = $x->mantissa()->bstr();';

    } elsif ($f eq "parts") {

        $try .= ' ($m, $e) = $x->parts();';

        # ->bstr() to see if an object is returned

        $try .= ' $m = $m->bstr(); $m = "NaN" if !defined $m;';

        $try .= ' $e = $e->bstr(); $e = "NaN" if !defined $e;';

        $try .= ' "$m,$e";';

    } elsif ($f eq "bexp") {

        $try .= " \$x->bexp();";

    } elsif ($f eq "bpi") {

        $try .= " $CLASS\->bpi(\$x);";

    } else {

        # binary operators

        $try .= qq| \$y = $CLASS->new("$args[1]");|;

        if ($f eq "bcmp") {

            $try .= ' $x->bcmp($y);';

        } elsif ($f eq "bround") {

            $try .= " $round_mode; \$x->bround(\$y);";

        } elsif ($f eq "bacmp") {

            $try .= ' $x->bacmp($y);';

        } elsif ($f eq "badd") {

            $try .= ' $x->badd($y);';

        } elsif ($f eq "bsub") {

            $try .= ' $x->bsub($y);';

        } elsif ($f eq "bmul") {

            $try .= ' $x->bmul($y);';

        } elsif ($f eq "bdiv") {

            $try .= ' $x->bdiv($y);';

        } elsif ($f eq "bdiv-list") {

            $try .= ' join(",", $x->bdiv($y));';

        } elsif ($f eq "btdiv") {

            $try .= ' $x->btdiv($y);';

        } elsif ($f eq "btdiv-list") {

            $try .= ' join (",", $x->btdiv($y));';

        # overload via x=

        } elsif ($f =~ /^.=$/) {

            $try .= " \$x $f \$y;";

            # overload via x

        } elsif ($f =~ /^.$/) {

            $try .= " \$x $f \$y;";

        } elsif ($f eq "bmod") {

            $try .= ' $x % $y;';

        } elsif ($f eq "bgcd") {

            if (defined $args[2]) {

                $try .= qq| \$z = $CLASS->new("$args[2]");|;

            }

            $try .= " $CLASS\::bgcd(\$x, \$y";

            $try .= ", \$z" if defined $args[2];

            $try .= ");";

        } elsif ($f eq "blcm") {

            if (defined $args[2]) {

                $try .= qq| \$z = $CLASS->new("$args[2]");|;

            }

            $try .= " $CLASS\::blcm(\$x, \$y";

            $try .= ", \$z" if defined $args[2];

            $try .= ");";

        } elsif ($f eq "blsft") {

            if (defined $args[2]) {

                $try .= " \$x->blsft(\$y, $args[2]);";

            } else {

                $try .= " \$x << \$y;";

            }

        } elsif ($f eq "brsft") {

            if (defined $args[2]) {

                $try .= " \$x->brsft(\$y, $args[2]);";

            } else {

                $try .= " \$x >> \$y;";

            }

        } elsif ($f eq "bnok") {

            $try .= " \$x->bnok(\$y);";

        } elsif ($f eq "broot") {

            $try .= " \$x->broot(\$y);";

        } elsif ($f eq "blog") {

            $try .= " \$x->blog(\$y);";

        } elsif ($f eq "band") {

            $try .= " \$x & \$y;";

        } elsif ($f eq "bior") {

            $try .= " \$x | \$y;";

        } elsif ($f eq "bxor") {

            $try .= " \$x ^ \$y;";

        } elsif ($f eq "bpow") {

            $try .= " \$x ** \$y;";

        } elsif ( $f eq "bmodinv") {

            $try .= " \$x->bmodinv(\$y);";

        } elsif ($f eq "digit") {

            $try .= " \$x->digit(\$y);";

        } elsif ($f eq "batan2") {

            $try .= " \$x->batan2(\$y);";

        } else {

            # Functions with three arguments

            $try .= qq| \$z = $CLASS->new("$args[2]");|;

            if ( $f eq "bmodpow") {

                $try .= " \$x->bmodpow(\$y, \$z);";

            } elsif ($f eq "bmuladd") {

                $try .= " \$x->bmuladd(\$y, \$z);";

            } else {

                warn "Unknown op '$f'";

            }

        }

    }                           # end else all other ops

    $got = eval $try;

    print "# Error: $@\n" if $@;

    # convert hex/binary targets to decimal

    if ($want =~ /^(0x0x|0b0b)/) {

        $want =~ s/^0[xb]//;

        $want = Math::BigInt->new($want)->bstr();

    }

    if ($want eq "") {

        is($got, undef, $try);

    } else {

        # print "try: $try ans: $got $want\n";

        is($got, $want, $try);

        is(ref($got), $expected_class,

           qq|output is a "$expected_class" object|)

          if $expected_class ne $CLASS;

    }

    # check internal state of number objects

    is_valid($got, $f) if ref $got;

}                               # end while data tests

close DATA;

# test whether self-multiplication works correctly (result is 2**64)

$try = qq|\$x = $CLASS->new("4294967296");|;

$try .= ' $a = $x->bmul($x);';

$got = eval $try;

is($got, $CLASS->new(2) ** 64, $try);

# test self-pow

$try = qq|\$x = $CLASS->new(10);|;

$try .= ' $a = $x->bpow($x);';

$got = eval $try;

is($got, $CLASS->new(10) ** 10, $try);

###############################################################################

# test whether op destroys args or not (should better not)

$x = $CLASS->new(3);

$y = $CLASS->new(4);

$z = $x & $y;

is($x, 3, '$z = $x & $y; $x');

is($y, 4, '$z = $x & $y; $y');

is($z, 0, '$z = $x & $y; $z');

$z = $x | $y;

is($x, 3, '$z = $x | $y; $x');

is($y, 4, '$z = $x | $y; $y');

is($z, 7, '$z = $x | $y; $z');

$x = $CLASS->new(1);

$y = $CLASS->new(2);

$z = $x | $y;

is($x, 1, '$z = $x | $y; $x');

is($y, 2, '$z = $x | $y; $y');

is($z, 3, '$z = $x | $y; $z');

$x = $CLASS->new(5);

$y = $CLASS->new(4);

$z = $x ^ $y;

is($x, 5, '$z = $x ^ $y; $x');

is($y, 4, '$z = $x ^ $y; $y');

is($z, 1, '$z = $x ^ $y; $z');

$x = $CLASS->new(-5);

$y = -$x;

is($x, -5, '$y = -$x; $x');

$x = $CLASS->new(-5);

$y = abs($x);

is($x, -5, '$y = abs($x); $x');

$x = $CLASS->new(8);

$y = $CLASS->new(-1);

$z = $CLASS->new(5033);

my $u = $x->copy()->bmodpow($y, $z);

is($u, 4404, '$x->copy()->bmodpow($y, $z); $u');

is($y, -1,   '$x->copy()->bmodpow($y, $z); $y');

is($z, 5033, '$x->copy()->bmodpow($y, $z); $z');

$x = $CLASS->new(-5);

$y = -$x;

is($x, -5, '$y = -$x; $x');

is($y, 5,  '$y = -$x; $y');

$x = $CLASS->new(-5);

$y = $x->copy()->bneg();

is($x, -5, '$y = $x->copy()->bneg(); $x');

is($y, 5,  '$y = $x->copy()->bneg(); $y');

$x = $CLASS->new(-5);

$y = $CLASS->new(3);

$x->bmul($y);

is($x, -15, '$x->bmul($y); $x');

is($y, 3,   '$x->bmul($y); $y');

$x = $CLASS->new(-5);

$y = $CLASS->new(3);

$x->badd($y);

is($x, -2, '$x->badd($y); $x');

is($y, 3,  '$x->badd($y); $y');

$x = $CLASS->new(-5);

$y = $CLASS->new(3);

$x->bsub($y);

is($x, -8, '$x->bsub($y); $x');

is($y, 3,  '$x->bsub($y); $y');

$x = $CLASS->new(-15);

$y = $CLASS->new(3);

$x->bdiv($y);

is($x, -5, '$x->bdiv($y); $x');

is($y, 3,  '$x->bdiv($y); $y');

$x = $CLASS->new(-5);

$y = $CLASS->new(3);

$x->bmod($y);

is($x, 1, '$x->bmod($y); $x');

is($y, 3, '$x->bmod($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(3);

$x->bmul($y);

is($x, 15, '$x->bmul($y); $x');

is($y, 3,  '$x->bmul($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(3);

$x->badd($y);

is($x, 8, '$x->badd($y); $x');

is($y, 3, '$x->badd($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(3);

$x->bsub($y);

is($x, 2, '$x->bsub($y); $x');

is($y, 3, '$x->bsub($y); $y');

$x = $CLASS->new(15);

$y = $CLASS->new(3);

$x->bdiv($y);

is($x, 5, '$x->bdiv($y); $x');

is($y, 3, '$x->bdiv($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(3);

$x->bmod($y);

is($x, 2, '$x->bmod($y); $x');

is($y, 3, '$x->bmod($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(-3);

$x->bmul($y);

is($x, -15, '$x->bmul($y); $x');

is($y, -3,  '$x->bmul($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(-3);

$x->badd($y);

is($x, 2,  '$x->badd($y); $x');

is($y, -3, '$x->badd($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(-3);

$x->bsub($y);

is($x, 8,  '$x->bsub($y); $x');

is($y, -3, '$x->bsub($y); $y');

$x = $CLASS->new(15);

$y = $CLASS->new(-3);

$x->bdiv($y);

is($x, -5, '$x->bdiv($y); $x');

is($y, -3, '$x->bdiv($y); $y');

$x = $CLASS->new(5);

$y = $CLASS->new(-3);

$x->bmod($y);

is($x, -1, '$x->bmod($y); $x');

is($y, -3, '$x->bmod($y); $y');

###############################################################################

# check whether overloading cmp works

$try = '$x = $CLASS->new(0);';

$try .= ' $y = 10;';

$try .= ' $x ne $y;';

$want = eval $try;

ok($want, "overloading cmp works");

# We can't test for working cmpt with other objects here, we would need a dummy

# object with stringify overload for this. See Math::String tests as example.

###############################################################################

# check reversed order of arguments

$try = "\$x = $CLASS->new(10); \$x = 2 ** \$x; \$x == 1024;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS->new(10); \$x = 2 * \$x; \$x == 20;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS->new(10); \$x = 2 + \$x; \$x == 12;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(10); \$x = 2 - \$x; \$x == -8;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(10); \$x = 20 / \$x; \$x == 2;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(3); \$x = 20 % \$x; \$x == 2;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(7); \$x = 20 & \$x; \$x == 4;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(7); \$x = 0x20 | \$x; \$x == 0x27;";

$want = eval $try;

ok($want, $try);

$try = "\$x = $CLASS\->new(7); \$x = 0x20 ^ \$x; \$x == 0x27;";

$want = eval $try;

ok($want, $try);

###############################################################################

# check badd(4, 5) form

$try = "\$x = $CLASS\->badd(4, 5); \$x == 9;";

$want = eval $try;

ok($want, $try);

###############################################################################

# check undefs: NOT DONE YET

###############################################################################

# bool

$x = $CLASS->new(1);

if ($x) {

    pass("\$x = $CLASS->new(1); \$x is true");

} else {

    fail("\$x = $CLASS->new(1); \$x is true");

}

$x = $CLASS->new(0);

if (!$x) {

    pass("\$x = $CLASS->new(0); !\$x is false");

} else {

    fail("\$x = $CLASS->new(0); !\$x is false");

}

###############################################################################

# objectify()

@args = Math::BigInt::objectify(2, 4, 5);

is(scalar(@args), 3,                 "objectify(2, 4, 5) gives $CLASS, 4, 5");

like($args[0],    qr/^Math::BigInt/, "first arg matches /^Math::BigInt/");

is($args[1],      4,                 "second arg is 4");

is($args[2],      5,                 "third arg is 5");

@args = Math::BigInt::objectify(0, 4, 5);

is(scalar(@args), 3,                 "objectify(0, 4, 5) gives $CLASS, 4, 5");

like($args[0],    qr/^Math::BigInt/, "first arg matches /^Math::BigInt/");

is($args[1],      4,                 "second arg is 4");

is($args[2],      5,                 "third arg is 5");

@args = Math::BigInt::objectify(2, 4, 5);

is(scalar(@args), 3,                 "objectify(2, 4, 5) gives $CLASS, 4, 5");

like($args[0],    qr/^Math::BigInt/, "first arg matches /^Math::BigInt/");

is($args[1],      4,                 "second arg is 4");

is($args[2],      5,                 "third arg is 5");

@args = Math::BigInt::objectify(2, 4, 5, 6, 7);

is(scalar(@args), 5,

   "objectify(2, 4, 5, 6, 7) gives $CLASS, 4, 5, 6, 7");

like($args[0],    qr/^Math::BigInt/, "first arg matches /^Math::BigInt/");

is($args[1],      4,                 "second arg is 4");

is(ref($args[1]), $args[0],          "second arg is a $args[0] object");

is($args[2],      5,                 "third arg is 5");

is(ref($args[2]), $args[0],          "third arg is a $args[0] object");

is($args[3],      6,                 "fourth arg is 6");

is(ref($args[3]), '',                "fourth arg is a scalar");

is($args[4],      7,                 "fifth arg is 7");

is(ref($args[4]), '',                "fifth arg is a scalar");

@args = Math::BigInt::objectify(2, $CLASS, 4, 5, 6, 7);

is(scalar(@args), 5,

   "objectify(2, $CLASS, 4, 5, 6, 7) gives $CLASS, 4, 5, 6, 7");

is($args[0],      $CLASS,            "first arg is $CLASS");

is($args[1],      4,                 "second arg is 4");

is(ref($args[1]), $args[0],          "second arg is a $args[0] object");

is($args[2],      5,                 "third arg is 5");

is(ref($args[2]), $args[0],          "third arg is a $args[0] object");

is($args[3],      6,                 "fourth arg is 6");

is(ref($args[3]), '',                "fourth arg is a scalar");

is($args[4],      7,                 "fifth arg is 7");

is(ref($args[4]), '',                "fifth arg is a scalar");

###############################################################################

# test whether an opp calls objectify properly or not (or at least does what

# it should do given non-objects, w/ or w/o objectify())

is($CLASS->new(123)->badd(123), 246,

   qq|$CLASS->new(123)->badd(123) = 246|);;

is($CLASS->badd(123, 321), 444,

   qq|$CLASS->badd(123, 321) = 444|);;

is($CLASS->badd(123, $CLASS->new(321)), 444,

   qq|$CLASS->badd(123, $CLASS->new(321)) = 444|);;

is($CLASS->new(123)->bsub(122), 1,

   qq|$CLASS->new(123)->bsub(122) = 1|);;

is($CLASS->bsub(321, 123), 198,

   qq|$CLASS->bsub(321, 123) = 198|);;

is($CLASS->bsub(321, $CLASS->new(123)), 198,

   qq|$CLASS->bsub(321, $CLASS->new(123)) = 198|);;

is($CLASS->new(123)->bmul(123), 15129,

   qq|$CLASS->new(123)->bmul(123) = 15129|);;

is($CLASS->bmul(123, 123), 15129,

   qq|$CLASS->bmul(123, 123) = 15129|);;

is($CLASS->bmul(123, $CLASS->new(123)), 15129,

   qq|$CLASS->bmul(123, $CLASS->new(123)) = 15129|);;

is($CLASS->new(15129)->bdiv(123), 123,

   qq|$CLASS->new(15129)->bdiv(123) = 123|);;

is($CLASS->bdiv(15129, 123), 123,

   qq|$CLASS->bdiv(15129, 123) = 123|);;

is($CLASS->bdiv(15129, $CLASS->new(123)), 123,

   qq|$CLASS->bdiv(15129, $CLASS->new(123)) = 123|);;

is($CLASS->new(15131)->bmod(123), 2,

   qq|$CLASS->new(15131)->bmod(123) = 2|);;

is($CLASS->bmod(15131, 123), 2,

   qq|$CLASS->bmod(15131, 123) = 2|);;

is($CLASS->bmod(15131, $CLASS->new(123)), 2,

   qq|$CLASS->bmod(15131, $CLASS->new(123)) = 2|);;

is($CLASS->new(2)->bpow(16), 65536,

   qq|$CLASS->new(2)->bpow(16) = 65536|);;

is($CLASS->bpow(2, 16), 65536,

   qq|$CLASS->bpow(2, 16) = 65536|);;

is($CLASS->bpow(2, $CLASS->new(16)), 65536,

   qq|$CLASS->bpow(2, $CLASS->new(16)) = 65536|);;

is($CLASS->new(2**15)->brsft(1), 2**14,

   qq|$CLASS->new(2**15)->brsft(1) = 2**14|);;

is($CLASS->brsft(2**15, 1), 2**14,

   qq|$CLASS->brsft(2**15, 1) = 2**14|);;

is($CLASS->brsft(2**15, $CLASS->new(1)), 2**14,

   qq|$CLASS->brsft(2**15, $CLASS->new(1)) = 2**14|);;

is($CLASS->new(2**13)->blsft(1), 2**14,

   qq|$CLASS->new(2**13)->blsft(1) = 2**14|);;

is($CLASS->blsft(2**13, 1), 2**14,

   qq|$CLASS->blsft(2**13, 1) = 2**14|);;

is($CLASS->blsft(2**13, $CLASS->new(1)), 2**14,

   qq|$CLASS->blsft(2**13, $CLASS->new(1)) = 2**14|);;

###############################################################################

# test for floating-point input (other tests in bnorm() below)

$z = 1050000000000000;          # may be int on systems with 64bit?

$x = $CLASS->new($z);

is($x->bsstr(), '105e+13',	# not 1.05e+15

   qq|\$x = $CLASS->new($z); \$x->bsstr() = "105e+13"|);

$z = 1e+129;			# definitely a float (may fail on UTS)

# don't compare to $z, since some Perl versions stringify $z into something

# like '1.e+129' or something equally ugly

SKIP:{

    my $vax_float = (pack("d", 1) =~ /^[\x80\x10]\x40/);

    skip("vax float range smaller", 1) if $vax_float;

    $x = $CLASS->new($z);

    is($x -> bsstr(), '1e+129',

       qq|\$x = $CLASS->new($z); \$x->bsstr() = "1e+129"|);

}

###############################################################################

# test for whitespace including newlines to be handled correctly

# is($Math::BigInt::strict, 1);		# the default

foreach my $c (qw/1 12 123 1234 12345 123456 1234567

                  12345678 123456789 1234567890/)

{

    my $m = $CLASS->new($c);

    is($CLASS->new("$c"),        $m,    qq|$CLASS->new("$c") = $m|);

    is($CLASS->new(" $c"),       $m,    qq|$CLASS->new(" $c") = $m|);

    is($CLASS->new("$c "),       $m,    qq|$CLASS->new("$c ") = $m|);

    is($CLASS->new(" $c "),      $m,    qq|$CLASS->new(" $c ") = $m|);

    is($CLASS->new("\n$c"),      $m,    qq|$CLASS->new("\\n$c") = $m|);

    is($CLASS->new("$c\n"),      $m,    qq|$CLASS->new("$c\\n") = $m|);

    is($CLASS->new("\n$c\n"),    $m,    qq|$CLASS->new("\\n$c\\n") = $m|);

    is($CLASS->new(" \n$c\n"),   $m,    qq|$CLASS->new(" \\n$c\\n") = $m|);

    is($CLASS->new(" \n$c \n"),  $m,    qq|$CLASS->new(" \\n$c \\n") = $m|);

    is($CLASS->new(" \n$c\n "),  $m,    qq|$CLASS->new(" \\n$c\\n ") = $m|);

    is($CLASS->new(" \n$c\n1"),  'NaN', qq|$CLASS->new(" \\n$c\\n1") = 'NaN'|);

    is($CLASS->new("1 \n$c\n1"), 'NaN', qq|$CLASS->new("1 \\n$c\\n1") = 'NaN'|);

}

###############################################################################

# prime number tests, also test for **= and length()

# found on: http://www.utm.edu/research/primes/notes/by_year.html

# ((2^148)+1)/17

$x = $CLASS->new(2);

$x **= 148;

$x++;

$x = $x / 17;

is($x, "20988936657440586486151264256610222593863921",

   "value of ((2^148)+1)/17");

is($x->length(), length("20988936657440586486151264256610222593863921"),

   "number of digits in ((2^148)+1)/17");

# MM7 = 2^127-1

$x = $CLASS->new(2);

$x **= 127;

$x--;

is($x, "170141183460469231731687303715884105727", "value of 2^127-1");

$x = $CLASS->new('215960156869840440586892398248');

($x, $y) = $x->length();

is($x, 30, "number of digits in 2^127-1");

is($y, 0, "number of digits in fraction part of 2^127-1");

$x = $CLASS->new('1_000_000_000_000');

($x, $y) = $x->length();

is($x, 13, "number of digits in 1_000_000_000_000");

is($y, 0, "number of digits in fraction part of 1_000_000_000_000");

# test <<=, >>=

$x = $CLASS->new('2');

$y = $CLASS->new('18');

is($x <<= $y, 2 << 18, "2 <<= 18 with $CLASS objects");

is($x,        2 << 18, "2 <<= 18 with $CLASS objects");

is($x >>= $y, 2,       "2 >>= 18 with $CLASS objects");

is($x,        2,       "2 >>= 18 with $CLASS objects");

# I am afraid the following is not yet possible due to slowness

# Also, testing for 2 meg output is a bit hard ;)

#$x = $CLASS->new(2);

#$x **= 6972593;

#$x--;

# 593573509*2^332162+1 has exactly 1,000,000 digits

# takes about 24 mins on 300 Mhz, so cannot be done yet ;)

#$x = $CLASS->new(2);

#$x **= 332162;

#$x *= "593573509";

#$x++;

#is($x->length(), 1_000_000);

###############################################################################

# inheritance and overriding of _swap

$x = Math::Foo->new(5);

$x = $x - 8;		# 8 - 5 instead of 5-8

is($x, 3, '$x = Math::Foo->new(5); $x = $x - 8; $x = 3');

is(ref($x), 'Math::Foo', '$x is an object of class "Math::Foo"');

$x = Math::Foo->new(5);

$x = 8 - $x;		# 5 - 8 instead of 8 - 5

is($x, -3, '$x = Math::Foo->new(5); $x = 8 - $x; $x = -3');

is(ref($x), 'Math::Foo', '$x is an object of class "Math::Foo"');

###############################################################################

# Test whether +inf eq inf

#

# This tried to test whether Math::BigInt inf equals Perl inf. Unfortunately,

# Perl hasn't (before 5.7.3 at least) a consistent way to say inf, and some

# things like 1e100000 crash on some platforms. So simple test for the string

# 'inf'.

$x = $CLASS->new('+inf');

is($x, 'inf', qq|$CLASS->new("+inf") = "inf"|);

###############################################################################

# numify() and 64 bit integer support

require Config;

SKIP: {

    skip("no 64 bit integer support", 4)

      if ! $Config::Config{use64bitint} || ! $Config::Config{use64bitall}

          || $] <= 5.006002;

    # The following should not give "1.84467440737096e+19".

    $x = $CLASS -> new(2) -> bpow(64) -> bdec();

    is($x -> bstr(),   "18446744073709551615", "bigint 2**64-1 as string");

    is($x -> numify(), "18446744073709551615", "bigint 2**64-1 as number");

    # The following should not give "-9.22337203685478e+18".

    $x = $CLASS -> new(2) -> bpow(63) -> bneg();

    is($x -> bstr(),   "-9223372036854775808", "bigint -2**63 as string");

    is($x -> numify(), "-9223372036854775808", "bigint -2**63 as number");

};

###############################################################################

###############################################################################

# the following tests only make sense with Math::BigInt::Calc or BareCalc or

# FastCalc

SKIP: {

    # skip GMP, Pari et al.

    skip("skipping tests not intended for the backend $CALC", 50)

      unless $CALC =~ /^Math::BigInt::(Bare|Fast)?Calc$/;

    ###########################################################################

    # check proper length of internal arrays

    my $bl = $CALC->_base_len();

    my $BASE = '9' x $bl;

    my $MAX = $BASE;

    $BASE++;

    # f.i. 9999

    $x = $CLASS->new($MAX);

    is_valid($x);

    # 10000

    $x += 1;

    is($x, $BASE, "\$x == $BASE");

    is_valid($x);

    # 9999 again

    $x -= 1;

    is($x, $MAX, "\$x == $MAX");

    is_valid($x);

    ###########################################################################

    # check numify

    $x = $CLASS->new($BASE-1);

    is($x->numify(), $BASE-1, q|$x->numify() = $BASE-1|);

    $x = $CLASS->new(-($BASE-1));

    is($x->numify(), -($BASE-1), q|$x->numify() = -($BASE-1)|);

    # +0 is to protect from 1e15 vs 100000000 (stupid to_string aaarglburbll...)

    $x = $CLASS->new($BASE);

    is($x->numify()+0, $BASE+0, q|$x->numify()+0 = $BASE+0|);

    $x = $CLASS->new(-$BASE);

    is($x->numify(), -$BASE, q|$x->numify() = -$BASE|);

    $x = $CLASS->new(-($BASE*$BASE*1+$BASE*1+1));

    is($x->numify(), -($BASE*$BASE*1+$BASE*1+1),

       q|$x->numify() = -($BASE*$BASE*1+$BASE*1+1))|);

    ###########################################################################

    # test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead

    # of 1

    $x = $CLASS->new($BASE - 2);

    $x++;

    $x++;

    $x++;

    $x++;

    ok($x > $BASE, '$x > $BASE');

    $x = $CLASS->new($BASE + 3);

    $x++;

    ok($x > $BASE, '$x > $BASE');

    # test for +0 instead of int():

    $x = $CLASS->new($MAX);

    is($x->length(), length($MAX), q|$x->length() = length($MAX)|);

    ###########################################################################

    # test bug that $CLASS->digit($string) did not work

    is($CLASS->digit(123, 2), 1, qq|$CLASS->digit(123, 2) = 1|);

    ###########################################################################

    # bug in sub where number with at least 6 trailing zeros after any op failed

    $x = $CLASS->new(123456);

    $z = $CLASS->new(10000);

    $z *= 10;

    $x -= $z;

    is($z, 100000, "testing bug in sub");

    is($x, 23456, "testing bug in sub");

    ###########################################################################

    # bug in shortcut in mul()

    # construct a number with a zero-hole of BASE_LEN_SMALL

    {

        my @bl = $CALC->_base_len();

        my $bl = $bl[5];

        $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;

        $y = '1' x (2 * $bl);

        $x = $CLASS->new($x)->bmul($y);

        # result is 123..$bl .  $bl x (3*bl-1) . $bl...321 . '0' x $bl

        $y = '';

        my $d = '';

        for (my $i = 1; $i <= $bl; $i++) {

            $y .= $i;

            $d = $i . $d;

        }

        $y .= $bl x (3 * $bl - 1) . $d . '0' x $bl;

        is($x, $y, "testing number with a zero-hole of BASE_LEN_SMALL");

        #########################################################################

        # see if mul shortcut for small numbers works

        $x = '9' x $bl;

        $x = $CLASS->new($x);

        # 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001

        is($x * $x, '9' x ($bl - 1) . '8' . '0' x ($bl - 1) . '1',

           "see if mul shortcut for small numbers works");

    }

    ###########################################################################

    # bug with rest "-0" in div, causing further div()s to fail

    $x = $CLASS->new('-322056000');

    ($x, $y) = $x->bdiv('-12882240');

    is($y, '0', '-322056000 / -12882240 has remainder 0');

    is_valid($y);               # $y not '-0'

    ###########################################################################

    # bug in $x->bmod($y)

    # if $x < 0 and $y > 0

    $x = $CLASS->new('-629');

    is($x->bmod(5033), 4404, q|$x->bmod(5033) = 4404|);

    ###########################################################################

    # bone/binf etc as plain calls (Lite failed them)

    is($CLASS->bzero(),      0,      qq|$CLASS->bzero() = 0|);

    is($CLASS->bone(),       1,      qq|$CLASS->bone() = 1|);

    is($CLASS->bone("+"),    1,      qq|$CLASS->bone("+") = 1|);

    is($CLASS->bone("-"),    -1,     qq|$CLASS->bone("-") = -1|);

    is($CLASS->bnan(),       "NaN",  qq|$CLASS->bnan() = "NaN"|);

    is($CLASS->binf(),       "inf",  qq|$CLASS->binf() = "inf"|);

    is($CLASS->binf("+"),    "inf",  qq|$CLASS->binf("+") = "inf"|);

    is($CLASS->binf("-"),    "-inf", qq|$CLASS->binf("-") = "-inf"|);

    is($CLASS->binf("-inf"), "-inf", qq|$CLASS->binf("-inf") = "-inf"|);

    ###########################################################################

    # is_one("-")

    is($CLASS->new(1)->is_one("-"),  0, qq|$CLASS->new(1)->is_one("-") = 0|);

    is($CLASS->new(-1)->is_one("-"), 1, qq|$CLASS->new(-1)->is_one("-") = 1|);

    is($CLASS->new(1)->is_one(),     1, qq|$CLASS->new(1)->is_one() = 1|);

    is($CLASS->new(-1)->is_one(),    0, qq|$CLASS->new(-1)->is_one() = 0|);

    ###########################################################################

    # [perl #30609] bug with $x -= $x not being 0, but 2*$x

    $x = $CLASS->new(3);

    $x -= $x;

    is($x, 0, qq|\$x = $CLASS->new(3); \$x -= \$x; = 0|);

    $x = $CLASS->new(-3);

    $x -= $x;

    is($x, 0, qq|\$x = $CLASS->new(-3); \$x -= \$x; = 0|);

    $x = $CLASS->new("NaN");

    $x -= $x;

    is($x->is_nan(), 1,

       qq|\$x = $CLASS->new("NaN"); \$x -= \$x; \$x->is_nan() = 1|);

    $x = $CLASS->new("inf");

    $x -= $x;

    is($x->is_nan(), 1,

       qq|\$x = $CLASS->new("inf"); \$x -= \$x; \$x->is_nan() = 1|);

    $x = $CLASS->new("-inf");

    $x -= $x;

    is($x->is_nan(), 1,

       qq|\$x = $CLASS->new("-inf"); \$x -= \$x; \$x->is_nan() = 1|);

    $x = $CLASS->new("NaN");

    $x += $x;

    is($x->is_nan(), 1,