view release on metacpan or  search on metacpan

cpan/Math-BigInt/t/upgrade.inc  view on Meta::CPAN

##############################################################################
package main;

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

my ($x, $y, $z, @args, $a, $m, $e, $try, $got, $want, $exp);
my ($f, $round_mode, $expected_class);

while (<DATA>) {
    s/#.*$//;                   # remove comments
    s/\s+$//;                   # remove trailing whitespace
    next unless length;         # skip empty lines

    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 = $EXPECTED_CLASS;
        $want =~ s/\^$//;
    }

    $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||(non_)?(negative|positive)|nan|int)$/) {
        $try .= " \$x->$f();";
    } elsif ($f =~ /^(to|as)_(hex|oct|bin)$/) {
        $try .= " \$x->$f();";
    } elsif ($f eq "is_inf") {
        $try .= " \$x->is_inf('$args[1]');";
    } elsif ($f eq "binf") {
        $try .= " \$x->binf('$args[1]');";
    } elsif ($f eq "bone") {
        $try .= " \$x->bone('$args[1]');";
    # some unary ops
    } elsif ($f =~ /^b(nan|floor|ceil|int|sstr|neg|abs|inc|dec|not|sqrt)$/) {
        $try .= " \$x->$f();";
    } elsif ($f eq "length") {
        $try .= ' $x->length();';
    } 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";';
    } else {
        if ($args[1] !~ /\./) {
            $try .= qq| \$y = $CLASS->new("$args[1]");|;
        } else {
            $try .= qq| \$y = $EXPECTED_CLASS->new("$args[1]");|;
        }
        if ($f eq "bcmp") {
            $try .= ' $x->bcmp($y);';
        } elsif ($f eq "bacmp") {
            $try .= ' $x->bacmp($y);';
        } elsif ($f eq "bround") {
            $try .= " $round_mode; \$x->bround(\$y);";
        } elsif ($f eq "broot") {
            $try .= " \$x->broot(\$y);";
        } elsif ($f eq "badd") {
            $try .= ' $x + $y;';
        } elsif ($f eq "bsub") {
            $try .= ' $x - $y;';
        } elsif ($f eq "bmul") {
            $try .= ' $x * $y;';
        } elsif ($f eq "bdiv") {
            $try .= ' $x / $y;';
        } elsif ($f eq "bdiv-list") {
            $try .= ' join(",", $x->bdiv($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 "band") {