view release on metacpan or  search on metacpan

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

package main;

is($CLASS->config('lib'), $LIB, "$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|(non_)?(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|exp)$/) {
        $try .= " \$x->$f();";
    } elsif ($f =~ /^b[dt]?fac$/) {
        $try .= " \$x->$f();";
    } elsif ($f =~ /^(numify|length|stringify)$/) {
        $try .= " \$x->$f();";
    } elsif ($f =~ /^(to|as)_(hex|oct|bin)$/) {
        $try .= " \$x->$f();";
    # overloaded functions
    } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) {
        $try .= " \$x = $f(\$x);";
    } 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 "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 "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;";
            }