summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorSteve Hay <steve.m.hay@googlemail.com>2016-01-04 13:32:30 +0000
committerSteve Hay <steve.m.hay@googlemail.com>2016-01-05 13:07:59 +0000
commit6b10d254fe18e6928745e2db24fec45528237d83 (patch)
tree73192a80c05c9f3e6f8e30064996df2e863a7b91 /cpan
parent11fa7e224a4213a94a79eab48bd69233905851f4 (diff)
downloadperl-6b10d254fe18e6928745e2db24fec45528237d83.tar.gz
Upgrade Math-BigInt from version 1.999710 to 1.999714
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Math-BigInt/lib/Math/BigFloat.pm1186
-rw-r--r--cpan/Math-BigInt/lib/Math/BigInt.pm2120
-rw-r--r--cpan/Math-BigInt/lib/Math/BigInt/Calc.pm854
-rw-r--r--cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm5
-rw-r--r--cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm56
-rw-r--r--cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm45
-rw-r--r--cpan/Math-BigInt/t/Math/BigInt/Scalar.pm515
-rw-r--r--cpan/Math-BigInt/t/Math/BigInt/Subclass.pm134
-rw-r--r--cpan/Math-BigInt/t/_e_math.t161
-rw-r--r--cpan/Math-BigInt/t/alias.inc22
-rw-r--r--cpan/Math-BigInt/t/bare_mbf.t16
-rw-r--r--cpan/Math-BigInt/t/bare_mbi.t20
-rw-r--r--cpan/Math-BigInt/t/bare_mif.t20
-rw-r--r--cpan/Math-BigInt/t/big_pi_e.t23
-rw-r--r--cpan/Math-BigInt/t/bigfltpm.inc842
-rw-r--r--cpan/Math-BigInt/t/bigfltpm.t34
-rw-r--r--cpan/Math-BigInt/t/bigintc.t972
-rw-r--r--cpan/Math-BigInt/t/bigintpm.inc1384
-rw-r--r--cpan/Math-BigInt/t/bigintpm.t47
-rw-r--r--cpan/Math-BigInt/t/bigints.t187
-rw-r--r--cpan/Math-BigInt/t/biglog.t245
-rw-r--r--cpan/Math-BigInt/t/bigroot.t58
-rw-r--r--cpan/Math-BigInt/t/blog-mbf.t264
-rw-r--r--cpan/Math-BigInt/t/blog-mbi.t264
-rw-r--r--cpan/Math-BigInt/t/calling.t140
-rw-r--r--cpan/Math-BigInt/t/config.t172
-rw-r--r--cpan/Math-BigInt/t/const_mbf.t14
-rw-r--r--cpan/Math-BigInt/t/constant.t45
-rw-r--r--cpan/Math-BigInt/t/downgrade.t64
-rw-r--r--cpan/Math-BigInt/t/from_hex-mbf.t12
-rw-r--r--cpan/Math-BigInt/t/inf_nan.t718
-rw-r--r--cpan/Math-BigInt/t/isa.t57
-rw-r--r--cpan/Math-BigInt/t/lib_load.t27
-rw-r--r--cpan/Math-BigInt/t/mbf_ali.t9
-rw-r--r--cpan/Math-BigInt/t/mbi_ali.t9
-rw-r--r--cpan/Math-BigInt/t/mbi_rand.t138
-rw-r--r--cpan/Math-BigInt/t/mbimbf.inc1541
-rw-r--r--cpan/Math-BigInt/t/mbimbf.t110
-rw-r--r--cpan/Math-BigInt/t/nan_cmp.t43
-rw-r--r--cpan/Math-BigInt/t/new_overloaded.t26
-rw-r--r--cpan/Math-BigInt/t/objectify_mbf.t15
-rw-r--r--cpan/Math-BigInt/t/objectify_mbi.t25
-rw-r--r--cpan/Math-BigInt/t/req_mbf0.t10
-rw-r--r--cpan/Math-BigInt/t/req_mbf1.t11
-rw-r--r--cpan/Math-BigInt/t/req_mbfa.t11
-rw-r--r--cpan/Math-BigInt/t/req_mbfi.t11
-rw-r--r--cpan/Math-BigInt/t/req_mbfn.t12
-rw-r--r--cpan/Math-BigInt/t/req_mbfw.t22
-rw-r--r--cpan/Math-BigInt/t/require.t14
-rw-r--r--cpan/Math-BigInt/t/round.t108
-rw-r--r--cpan/Math-BigInt/t/rt-16221.t4
-rw-r--r--cpan/Math-BigInt/t/sub_ali.t10
-rw-r--r--cpan/Math-BigInt/t/sub_mbf.t33
-rw-r--r--cpan/Math-BigInt/t/sub_mbi.t34
-rw-r--r--cpan/Math-BigInt/t/sub_mif.t9
-rw-r--r--cpan/Math-BigInt/t/trap.t127
-rw-r--r--cpan/Math-BigInt/t/upgrade.inc416
-rw-r--r--cpan/Math-BigInt/t/upgrade.t23
-rw-r--r--cpan/Math-BigInt/t/upgrade2.t5
-rw-r--r--cpan/Math-BigInt/t/upgradef.t81
-rw-r--r--cpan/Math-BigInt/t/use.t16
-rw-r--r--cpan/Math-BigInt/t/use_lib1.t12
-rw-r--r--cpan/Math-BigInt/t/use_lib2.t12
-rw-r--r--cpan/Math-BigInt/t/use_lib3.t12
-rw-r--r--cpan/Math-BigInt/t/use_lib4.t13
-rw-r--r--cpan/Math-BigInt/t/use_mbfw.t32
-rw-r--r--cpan/Math-BigInt/t/with_sub.t19
67 files changed, 7479 insertions, 6217 deletions
diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm
index a36c854723..df33362792 100644
--- a/cpan/Math-BigInt/lib/Math/BigFloat.pm
+++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm
@@ -12,11 +12,12 @@ package Math::BigFloat;
# _a : accuracy
# _p : precision
-use 5.006002;
+use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999710';
+our $VERSION = '1.999714';
+$VERSION = eval $VERSION;
require Exporter;
our @ISA = qw/Math::BigInt/;
@@ -29,21 +30,19 @@ our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
my $class = "Math::BigFloat";
use overload
-'<=>' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
- ref($_[0])->bcmp($_[0],$_[1]);
+ '<=>' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1], $_[0])
+ : ref($_[0])->bcmp($_[0], $_[1]);
$rc = 1 unless defined $rc;
$rc <=> 0;
},
# we need '>=' to get things like "1 >= NaN" right:
-'>=' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
- ref($_[0])->bcmp($_[0],$_[1]);
+ '>=' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1],$_[0])
+ : ref($_[0])->bcmp($_[0],$_[1]);
# if there was a NaN involved, return false
return '' unless defined $rc;
$rc >= 0;
},
-'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
+ 'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
;
##############################################################################
@@ -127,51 +126,72 @@ BEGIN
##############################################################################
# constructors
-sub new
- {
- # create a new BigFloat object from a string or another bigfloat object.
- # _e: exponent
- # _m: mantissa
- # sign => sign (+/-), or "NaN"
+sub new {
+ # Create a new BigFloat object from a string or another bigfloat object.
+ # _e: exponent
+ # _m: mantissa
+ # sign => sign ("+", "-", "+inf", "-inf", or "NaN"
- my ($class,$wanted,@r) = @_;
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- # avoid numify-calls by not using || on $wanted!
- return $class->bzero() if !defined $wanted; # default to 0
- return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
+ my ($wanted, @r) = @_;
- $class->import() if $IMPORT == 0; # make require work
+ # avoid numify-calls by not using || on $wanted!
- my $self = {}; bless $self, $class;
- # shortcut for bigints and its subclasses
- if ((ref($wanted)) && UNIVERSAL::can( $wanted, "as_number"))
- {
- $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
- $self->{_e} = $MBI->_zero();
- $self->{_es} = '+';
- $self->{sign} = $wanted->sign();
- return $self->bnorm();
+ unless (defined $wanted) {
+ require Carp;
+ Carp::carp("Use of uninitialized value in new");
+ return $self->bzero(@r);
}
- # else: got a string or something masquerading as number (with overload)
- # handle '+inf', '-inf' first
- if ($wanted =~ /^[+-]?inf\z/)
- {
- return $downgrade->new($wanted) if $downgrade;
+ # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on
+ # subroutine "Math::BigFloat::as_number"' in some tests. Fixme!
- $self->{sign} = $wanted; # set a default sign for bstr()
- return $self->binf($wanted);
+ if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) {
+ my $copy = $wanted -> copy();
+ if ($selfref) { # if new() called as instance method
+ %$self = %$copy;
+ } else { # if new() called as class method
+ $self = $copy;
+ }
+ return $copy;
}
- # shortcut for simple forms like '12' that neither have trailing nor leading
- # zeros
- if ($wanted =~ /^([+-]?)([1-9][0-9]*[1-9])$/)
- {
- $self->{_e} = $MBI->_zero();
- $self->{_es} = '+';
- $self->{sign} = $1 || '+';
- $self->{_m} = $MBI->_new($2);
- return $self->round(@r) if !$downgrade;
+ $class->import() if $IMPORT == 0; # make require work
+
+ # If called as a class method, initialize a new object.
+
+ $self = bless {}, $class unless $selfref;
+
+ # shortcut for bigints and its subclasses
+ if ((ref($wanted)) && $wanted -> can("as_number")) {
+ $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
+ $self->{sign} = $wanted->sign();
+ return $self->bnorm();
+ }
+
+ # else: got a string or something masquerading as number (with overload)
+
+ # Handle Infs.
+
+ if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
+ return $downgrade->new($wanted) if $downgrade;
+ my $sgn = $1 || '+';
+ $self->{sign} = $sgn . 'inf'; # set a default sign for bstr()
+ return $self->binf($sgn);
+ }
+
+ # Shortcut for simple forms like '12' that have no trailing zeros.
+ if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) {
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
+ $self->{sign} = $1 || '+';
+ $self->{_m} = $MBI->_new($2);
+ return $self->round(@r) if !$downgrade;
}
my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
@@ -244,34 +264,26 @@ sub new
$self->bnorm()->round(@r); # first normalize, then round
}
-sub copy
- {
- # if two arguments, the first one is the class to "swallow" subclasses
- if (@_ > 1)
- {
- my $self = bless {
- sign => $_[1]->{sign},
- _es => $_[1]->{_es},
- _m => $MBI->_copy($_[1]->{_m}),
- _e => $MBI->_copy($_[1]->{_e}),
- }, $_[0] if @_ > 1;
-
- $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
- $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
- return $self;
- }
+sub copy {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my $self = bless {
- sign => $_[0]->{sign},
- _es => $_[0]->{_es},
- _m => $MBI->_copy($_[0]->{_m}),
- _e => $MBI->_copy($_[0]->{_e}),
- }, ref($_[0]);
+ # If called as a class method, the object to copy is the next argument.
- $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
- $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
- $self;
- }
+ $self = shift() unless $selfref;
+
+ my $copy = bless {}, $class;
+
+ $copy->{sign} = $self->{sign};
+ $copy->{_es} = $self->{_es};
+ $copy->{_m} = $MBI->_copy($self->{_m});
+ $copy->{_e} = $MBI->_copy($self->{_e});
+ $copy->{_a} = $self->{_a} if exists $self->{_a};
+ $copy->{_p} = $self->{_p} if exists $self->{_p};
+
+ return $copy;
+}
sub _bnan
{
@@ -1613,49 +1625,46 @@ sub bgcd
##############################################################################
-sub _e_add
- {
- # Internal helper sub to take two positive integers and their signs and
- # then add them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')),
- # output ($CALC,('+'|'-'))
- my ($x,$y,$xs,$ys) = @_;
+sub _e_add {
+ # Internal helper sub to take two positive integers and their signs and
+ # then add them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')), output
+ # ($CALC, ('+'|'-')).
- # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
- if ($xs eq $ys)
- {
- $x = $MBI->_add ($x, $y ); # a+b
- # the sign follows $xs
- return ($x, $xs);
- }
+ my ($x, $y, $xs, $ys) = @_;
- my $a = $MBI->_acmp($x,$y);
- if ($a > 0)
- {
- $x = $MBI->_sub ($x , $y); # abs sub
- }
- elsif ($a == 0)
- {
- $x = $MBI->_zero(); # result is 0
- $xs = '+';
- }
- else # a < 0
- {
- $x = $MBI->_sub ( $y, $x, 1 ); # abs sub
- $xs = $ys;
+ # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
+ if ($xs eq $ys) {
+ $x = $MBI->_add($x, $y); # +a + +b or -a + -b
+ } else {
+ my $a = $MBI->_acmp($x, $y);
+ if ($a == 0) {
+ # This does NOT modify $x in-place. TODO: Fix this?
+ $x = $MBI->_zero(); # result is 0
+ $xs = '+';
+ return ($x, $xs);
+ }
+ if ($a > 0) {
+ $x = $MBI->_sub($x, $y); # abs sub
+ } else { # a < 0
+ $x = $MBI->_sub ( $y, $x, 1 ); # abs sub
+ $xs = $ys;
+ }
}
- ($x,$xs);
- }
-sub _e_sub
- {
+ $xs = '+' if $xs eq '-' && $MBI->_is_zero($x); # no "-0"
+
+ return ($x, $xs);
+}
+
+sub _e_sub {
# Internal helper sub to take two positive integers and their signs and
# then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')),
# output ($CALC,('+'|'-'))
my ($x,$y,$xs,$ys) = @_;
# flip sign
- $ys =~ tr/+-/-+/;
- _e_add($x,$y,$xs,$ys); # call add (does subtract now)
+ $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ...
+ _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job
}
###############################################################################
@@ -2809,94 +2818,174 @@ sub _atan_inv
($a,$b);
}
-sub bpi
- {
- my ($self,$n) = @_;
- if (@_ == 0)
- {
- $self = $class;
- }
- if (@_ == 1)
- {
- # called like Math::BigFloat::bpi(10);
- $n = $self; $self = $class;
- # called like Math::BigFloat->bpi();
- $n = undef if $n eq 'Math::BigFloat';
- }
- $self = ref($self) if ref($self);
- my $fallback = defined $n ? 0 : 1;
- $n = 40 if !defined $n || $n < 1;
-
- if ($n < 1000) {
-
- # after 黃見利 (Hwang Chien-Lih) (1997)
- # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) – 68 * atan(1/5832)
- # + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318)
-
- # Use a few more digits in the intermediate computations.
-
- my $nextra = $n < 800 ? 4 : 5;
- $n += $nextra;
-
- my ($a,$b) = $self->_atan_inv( $MBI->_new(239),$n);
- my ($c,$d) = $self->_atan_inv( $MBI->_new(1023),$n);
- my ($e,$f) = $self->_atan_inv( $MBI->_new(5832),$n);
- my ($g,$h) = $self->_atan_inv( $MBI->_new(110443),$n);
- my ($i,$j) = $self->_atan_inv( $MBI->_new(4841182),$n);
- my ($k,$l) = $self->_atan_inv( $MBI->_new(6826318),$n);
-
- $MBI->_mul($a, $MBI->_new(732));
- $MBI->_mul($c, $MBI->_new(128));
- $MBI->_mul($e, $MBI->_new(272));
- $MBI->_mul($g, $MBI->_new(48));
- $MBI->_mul($i, $MBI->_new(48));
- $MBI->_mul($k, $MBI->_new(400));
-
- my $x = $self->bone(); $x->{_m} = $a; my $x_d = $self->bone(); $x_d->{_m} = $b;
- my $y = $self->bone(); $y->{_m} = $c; my $y_d = $self->bone(); $y_d->{_m} = $d;
- my $z = $self->bone(); $z->{_m} = $e; my $z_d = $self->bone(); $z_d->{_m} = $f;
- my $u = $self->bone(); $u->{_m} = $g; my $u_d = $self->bone(); $u_d->{_m} = $h;
- my $v = $self->bone(); $v->{_m} = $i; my $v_d = $self->bone(); $v_d->{_m} = $j;
- my $w = $self->bone(); $w->{_m} = $k; my $w_d = $self->bone(); $w_d->{_m} = $l;
- $x->bdiv($x_d, $n);
- $y->bdiv($y_d, $n);
- $z->bdiv($z_d, $n);
- $u->bdiv($u_d, $n);
- $v->bdiv($v_d, $n);
- $w->bdiv($w_d, $n);
-
- delete $x->{_a}; delete $y->{_a}; delete $z->{_a};
- delete $u->{_a}; delete $v->{_a}; delete $w->{_a};
- $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w);
-
- $x->bround($n-$nextra);
- delete $x->{_a} if $fallback == 1;
- $x;
+sub bpi {
+
+ # Called as Argument list
+ # --------- -------------
+ # Math::BigFloat->bpi() ("Math::BigFloat")
+ # Math::BigFloat->bpi(10) ("Math::BigFloat", 10)
+ # $x->bpi() ($x)
+ # $x->bpi(10) ($x, 10)
+ # Math::BigFloat::bpi() ()
+ # Math::BigFloat::bpi(10) (10)
+ #
+ # In ambiguous cases, we favour the OO-style, so the following case
+ #
+ # $n = Math::BigFloat->new("10");
+ # $x = Math::BigFloat->bpi($n);
+ #
+ # which gives an argument list with the single element $n, is resolved as
+ #
+ # $n->bpi();
- } else {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- # For large accuracy, the arctan formulas become very inefficient with
- # Math::BigFloat. Switch to Brent-Salamin (aka AGM or Gauss-Legendre).
-
- # Use a few more digits in the intermediate computations.
- my $nextra = 8;
-
- $HALF = $self -> new($HALF) unless ref($HALF);
- my ($an, $bn, $tn, $pn) = ($self -> bone, $HALF -> copy -> bsqrt($n),
- $HALF -> copy -> bmul($HALF), $self -> bone);
- while ($pn < $n) {
- my $prev_an = $an -> copy;
- $an -> badd($bn) -> bmul($HALF, $n);
- $bn -> bmul($prev_an) -> bsqrt($n);
- $prev_an -> bsub($an);
- $tn -> bsub($pn * $prev_an * $prev_an);
- $pn -> badd($pn);
- }
- $an -> badd($bn);
- $an -> bmul($an, $n) -> bdiv(4 * $tn, $n - $nextra);
- delete $an -> {_a} if $fallback == 1;
- return $an;
- }
+ my $accu; # accuracy (number of digits)
+ my $prec; # precision
+ my $rndm; # round mode
+
+ # If bpi() is called as a function ...
+ #
+ # This cludge is necessary because we still support bpi() as a function. If
+ # bpi() is called with either no argument or one argument, and that one
+ # argument is either undefined or a scalar that looks like a number, then
+ # we assume bpi() is called as a function.
+
+ if (@_ == 0 &&
+ (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i)
+ ||
+ !defined($self))
+ {
+ $accu = $self;
+ $class = __PACKAGE__;
+ $self = $class -> bzero(); # initialize
+ }
+
+ # ... or if bpi() is called as a method ...
+
+ else {
+ if ($selfref) { # bpi() called as instance method
+ return $self if $self -> modify('bpi');
+ } else { # bpi() called as class method
+ $self = $class -> bzero(); # initialize
+ }
+ $accu = shift;
+ $prec = shift;
+ $rndm = shift;
+ }
+
+ my @r = ($accu, $prec, $rndm);
+
+ # We need to limit the accuracy to protect against overflow.
+ my $fallback = 0;
+ my ($scale, @params);
+ ($self, @params) = $self -> _find_round_parameters(@r);
+
+ # Error in _find_round_parameters?
+ #
+ # We can't return here, because that will fail if $self was a NaN when
+ # bpi() was invoked, and we want to assign pi to $x. It is probably not a
+ # good idea that _find_round_parameters() signals invalid round parameters
+ # by silently returning a NaN. Fixme!
+ #return $self if $self && $self->is_nan();
+
+ # No rounding at all, so must use fallback.
+ if (scalar @params == 0) {
+ # Simulate old behaviour
+ $params[0] = $self -> div_scale(); # and round to it as accuracy
+ $params[1] = undef; # disable P
+ $params[2] = $r[2]; # round mode by caller or undef
+ $fallback = 1; # to clear a/p afterwards
+ }
+
+ # The accuracy, i.e., the number of digits. Pi has one digit before the
+ # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits.
+
+ my $n = $params[0] || 1 - $params[1];
+
+ if ($n < 1000) {
+
+ # after 黃見利 (Hwang Chien-Lih) (1997)
+ # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) – 68 * atan(1/5832)
+ # + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318)
+
+ # Use a few more digits in the intermediate computations.
+
+ my $nextra = $n < 800 ? 4 : 5;
+ $n += $nextra;
+
+ my ($a, $b) = $class->_atan_inv($MBI->_new(239), $n);
+ my ($c, $d) = $class->_atan_inv($MBI->_new(1023), $n);
+ my ($e, $f) = $class->_atan_inv($MBI->_new(5832), $n);
+ my ($g, $h) = $class->_atan_inv($MBI->_new(110443), $n);
+ my ($i, $j) = $class->_atan_inv($MBI->_new(4841182), $n);
+ my ($k, $l) = $class->_atan_inv($MBI->_new(6826318), $n);
+
+ $MBI->_mul($a, $MBI->_new(732));
+ $MBI->_mul($c, $MBI->_new(128));
+ $MBI->_mul($e, $MBI->_new(272));
+ $MBI->_mul($g, $MBI->_new(48));
+ $MBI->_mul($i, $MBI->_new(48));
+ $MBI->_mul($k, $MBI->_new(400));
+
+ my $x = $class->bone(); $x->{_m} = $a; my $x_d = $class->bone(); $x_d->{_m} = $b;
+ my $y = $class->bone(); $y->{_m} = $c; my $y_d = $class->bone(); $y_d->{_m} = $d;
+ my $z = $class->bone(); $z->{_m} = $e; my $z_d = $class->bone(); $z_d->{_m} = $f;
+ my $u = $class->bone(); $u->{_m} = $g; my $u_d = $class->bone(); $u_d->{_m} = $h;
+ my $v = $class->bone(); $v->{_m} = $i; my $v_d = $class->bone(); $v_d->{_m} = $j;
+ my $w = $class->bone(); $w->{_m} = $k; my $w_d = $class->bone(); $w_d->{_m} = $l;
+ $x->bdiv($x_d, $n);
+ $y->bdiv($y_d, $n);
+ $z->bdiv($z_d, $n);
+ $u->bdiv($u_d, $n);
+ $v->bdiv($v_d, $n);
+ $w->bdiv($w_d, $n);
+
+ delete $x->{_a}; delete $y->{_a}; delete $z->{_a};
+ delete $u->{_a}; delete $v->{_a}; delete $w->{_a};
+ $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w);
+
+ for my $key (qw/ sign _m _es _e _a _p /) {
+ $self -> {$key} = $x -> {$key} if exists $x -> {$key};
+ }
+
+ } else {
+
+ # For large accuracy, the arctan formulas become very inefficient with
+ # Math::BigFloat. Switch to Brent-Salamin (aka AGM or Gauss-Legendre).
+
+ # Use a few more digits in the intermediate computations.
+ my $nextra = 8;
+
+ $HALF = $class -> new($HALF) unless ref($HALF);
+ my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy -> bsqrt($n),
+ $HALF -> copy -> bmul($HALF), $class -> bone);
+ while ($pn < $n) {
+ my $prev_an = $an -> copy;
+ $an -> badd($bn) -> bmul($HALF, $n);
+ $bn -> bmul($prev_an) -> bsqrt($n);
+ $prev_an -> bsub($an);
+ $tn -> bsub($pn * $prev_an * $prev_an);
+ $pn -> badd($pn);
+ }
+ $an -> badd($bn);
+ $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);
+
+ for my $key (qw/ sign _m _es _e _a _p /) {
+ $self -> {$key} = $an -> {$key} if exists $an -> {$key};;
+ }
+ }
+
+ $self -> round(@params);
+
+ if ($fallback) {
+ delete $self->{_a};
+ delete $self->{_p};
+ }
+
+ return $self;
}
sub bcos
@@ -3096,334 +3185,261 @@ sub bsin
$x;
}
-sub batan2
- {
- # calculate arcus tangens of ($y/$x)
-
- # set up parameters
- my ($self,$y,$x,@r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
- {
- ($self,$y,$x,@r) = objectify(2,@_);
+sub batan2 {
+ # $y -> batan2($x) returns the arcus tangens of $y / $x.
+
+ # Set up parameters.
+ my ($self, $y, $x, @r) = (ref($_[0]), @_);
+
+ # Objectify is costly, so avoid it if we can.
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
+ ($self, $y, $x, @r) = objectify(2, @_);
}
- return $y if $y->modify('batan2');
+ # Quick exit if $y is read-only.
+ return $y if $y -> modify('batan2');
- return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
+ # Handle all NaN cases.
+ return $y -> bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- # Y X
- # 0 0 result is 0
- # 0 +x result is 0
- # ? inf result is 0
- return $y->bzero(@r) if ($x->is_inf('+') && !$y->is_inf()) || ($y->is_zero() && $x->{sign} eq '+');
+ # We need to limit the accuracy to protect against overflow.
+ my $fallback = 0;
+ my ($scale, @params);
+ ($y, @params) = $y -> _find_round_parameters(@r);
- # Y X
- # != 0 -inf result is +- pi
- if ($x->is_inf() || $y->is_inf())
- {
- # calculate PI
- my $pi = $self->bpi(@r);
- if ($y->is_inf())
- {
- # upgrade to BigRat etc.
- return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
- if ($x->{sign} eq '-inf')
- {
- # calculate 3 pi/4
- $MBI->_mul($pi->{_m}, $MBI->_new(3));
- $MBI->_div($pi->{_m}, $MBI->_new(4));
- }
- elsif ($x->{sign} eq '+inf')
- {
- # calculate pi/4
- $MBI->_div($pi->{_m}, $MBI->_new(4));
- }
- else
- {
- # calculate pi/2
- $MBI->_div($pi->{_m}, $MBI->_new(2));
+ # Error in _find_round_parameters?
+ return $y if $y->is_nan();
+
+ # No rounding at all, so must use fallback.
+ if (scalar @params == 0) {
+ # Simulate old behaviour
+ $params[0] = $self -> div_scale(); # and round to it as accuracy
+ $params[1] = undef; # disable P
+ $scale = $params[0] + 4; # at least four more for proper round
+ $params[2] = $r[2]; # round mode by caller or undef
+ $fallback = 1; # to clear a/p afterwards
+ } else {
+ # The 4 below is empirical, and there might be cases where it is not
+ # enough ...
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
+ }
+
+ if ($x -> is_inf("+")) { # x = inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y -> bpi($scale) -> bmul("0.25"); # pi/4
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y -> bpi($scale) -> bmul("-0.25"); # -pi/4
+ } else { # -inf < y < inf
+ return $y -> bzero(@r); # 0
}
- $y->{sign} = substr($y->{sign},0,1); # keep +/-
- }
- # modify $y in place
- $y->{_m} = $pi->{_m};
- $y->{_e} = $pi->{_e};
- $y->{_es} = $pi->{_es};
- # keep the sign of $y
- return $y;
}
- return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade;
-
- # Y X
- # 0 -x result is PI
- if ($y->is_zero())
- {
- # calculate PI
- my $pi = $self->bpi(@r);
- # modify $y in place
- $y->{_m} = $pi->{_m};
- $y->{_e} = $pi->{_e};
- $y->{_es} = $pi->{_es};
- $y->{sign} = '+';
- return $y;
+ elsif ($x -> is_inf("-")) { # x = -inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi
+ } elsif ($y >= 0) { # y >= 0
+ $y -> bpi($scale); # pi
+ } else { # y < 0
+ $y -> bpi($scale) -> bneg(); # -pi
+ }
}
- # Y X
- # +y 0 result is PI/2
- # -y 0 result is -PI/2
- if ($x->is_zero())
- {
- # calculate PI/2
- my $pi = $self->bpi(@r);
- # modify $y in place
- $y->{_m} = $pi->{_m};
- $y->{_e} = $pi->{_e};
- $y->{_es} = $pi->{_es};
- # -y => -PI/2, +y => PI/2
- $MBI->_div($y->{_m}, $MBI->_new(2));
- return $y;
+ elsif ($x > 0) { # 0 < x < inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y -> bpi($scale) -> bmul("0.5"); # pi/2
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
+ } else { # -inf < y < inf
+ $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x)
+ }
}
- # we need to limit the accuracy to protect against overflow
- my $fallback = 0;
- my ($scale,@params);
- ($y,@params) = $y->_find_round_parameters(@r);
-
- # error in _find_round_parameters?
- return $y if $y->is_nan();
-
- # no rounding at all, so must use fallback
- if (scalar @params == 0)
- {
- # simulate old behaviour
- $params[0] = $self->div_scale(); # and round to it as accuracy
- $params[1] = undef; # disable P
- $scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r[2]; # round mode by caller or undef
- $fallback = 1; # to clear a/p afterwards
+ elsif ($x < 0) { # -inf < x < 0
+ my $pi = $class -> bpi($scale);
+ if ($y >= 0) { # y >= 0
+ $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi
+ -> badd($pi);
+ } else { # y < 0
+ $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi
+ -> bsub($pi);
+ }
}
- else
- {
- # the 4 below is empirical, and there might be cases where it is not
- # enough...
- $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
+
+ else { # x = 0
+ if ($y > 0) { # y > 0
+ $y -> bpi($scale) -> bmul("0.5"); # pi/2
+ } elsif ($y < 0) { # y < 0
+ $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
+ } else { # y = 0
+ return $y -> bzero(@r); # 0
+ }
}
- # inlined is_one() && is_one('-')
- if ($MBI->_is_one($y->{_m}) && $MBI->_is_zero($y->{_e}))
- {
- # shortcut: 1 1 result is PI/4
- # inlined is_one() && is_one('-')
- if ($MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
- {
- # 1,1 => PI/4
- my $pi_4 = $self->bpi( $scale - 3);
- # modify $y in place
- $y->{_m} = $pi_4->{_m};
- $y->{_e} = $pi_4->{_e};
- $y->{_es} = $pi_4->{_es};
- # 1 1 => +
- # -1 1 => -
- # 1 -1 => -
- # -1 -1 => +
- $y->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
- $MBI->_div($y->{_m}, $MBI->_new(4));
- return $y;
- }
- # shortcut: 1 int(X) result is _atan_inv(X)
+ $y -> round(@r);
- # is integer
- if ($x->{_es} eq '+')
- {
- my $x1 = $MBI->_copy($x->{_m});
- $MBI->_lsft($x1, $x->{_e},10) unless $MBI->_is_zero($x->{_e});
-
- my ($a,$b) = $self->_atan_inv($x1, $scale);
- my $y_sign = $y->{sign};
- # calculate A/B
- $y->bone(); $y->{_m} = $a; my $y_d = $self->bone(); $y_d->{_m} = $b;
- $y->bdiv($y_d, @r);
- $y->{sign} = $y_sign;
- return $y;
- }
+ if ($fallback) {
+ delete $y->{_a};
+ delete $y->{_p};
}
- # handle all other cases
- # X Y
- # +x +y 0 to PI/2
- # -x +y PI/2 to PI
- # +x -y 0 to -PI/2
- # -x -y -PI/2 to -PI
+ return $y;
+}
- my $y_sign = $y->{sign};
+sub batan {
+ # Calculate a arcus tangens of x.
- # divide $x by $y
- $y->bdiv($x, $scale) unless $x->is_one();
- $y->batan(@r);
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- # restore sign
- $y->{sign} = $y_sign;
+ my (@r) = @_;
- $y;
- }
+ # taylor: x^3 x^5 x^7 x^9
+ # atan = x - --- + --- - --- + --- ...
+ # 3 5 7 9
-sub batan
- {
- # Calculate a arcus tangens of x.
- my ($x,@r) = @_;
- my $self = ref($x);
+ # We need to limit the accuracy to protect against overflow.
- # taylor: x^3 x^5 x^7 x^9
- # atan = x - --- + --- - --- + --- ...
- # 3 5 7 9
+ my $fallback = 0;
+ my ($scale, @params);
+ ($self, @params) = $self->_find_round_parameters(@r);
- # we need to limit the accuracy to protect against overflow
- my $fallback = 0;
- my ($scale,@params);
- ($x,@params) = $x->_find_round_parameters(@r);
-
- # constant object or error in _find_round_parameters?
- return $x if $x->modify('batan') || $x->is_nan();
-
- if ($x->{sign} =~ /^[+-]inf\z/)
- {
- # +inf result is PI/2
- # -inf result is -PI/2
- # calculate PI/2
- my $pi = $self->bpi(@r);
- # modify $x in place
- $x->{_m} = $pi->{_m};
- $x->{_e} = $pi->{_e};
- $x->{_es} = $pi->{_es};
- # -y => -PI/2, +y => PI/2
- $x->{sign} = substr($x->{sign},0,1); # +inf => +
- $MBI->_div($x->{_m}, $MBI->_new(2));
- return $x;
- }
+ # Constant object or error in _find_round_parameters?
- return $x->bzero(@r) if $x->is_zero();
+ return $self if $self->modify('batan') || $self->is_nan();
- # no rounding at all, so must use fallback
- if (scalar @params == 0)
- {
- # simulate old behaviour
- $params[0] = $self->div_scale(); # and round to it as accuracy
- $params[1] = undef; # disable P
- $scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r[2]; # round mode by caller or undef
- $fallback = 1; # to clear a/p afterwards
- }
- else
- {
- # the 4 below is empirical, and there might be cases where it is not
- # enough...
- $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
- }
-
- # 1 or -1 => PI/4
- # inlined is_one() && is_one('-')
- if ($MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
- {
- my $pi = $self->bpi($scale - 3);
- # modify $x in place
- $x->{_m} = $pi->{_m};
- $x->{_e} = $pi->{_e};
- $x->{_es} = $pi->{_es};
- # leave the sign of $x alone (+1 => +PI/4, -1 => -PI/4)
- $MBI->_div($x->{_m}, $MBI->_new(4));
- return $x;
- }
-
- # This series is only valid if -1 < x < 1, so for other x we need to
- # to calculate PI/2 - atan(1/x):
- my $one = $MBI->_new(1);
- my $pi = undef;
- if ($x->{_es} eq '+' && ($MBI->_acmp($x->{_m},$one) >= 0))
- {
- # calculate PI/2
- $pi = $self->bpi($scale - 3);
- $MBI->_div($pi->{_m}, $MBI->_new(2));
- # calculate 1/$x:
- my $x_copy = $x->copy();
- # modify $x in place
- $x->bone(); $x->bdiv($x_copy,$scale);
+ if ($self->{sign} =~ /^[+-]inf\z/) {
+ # +inf result is PI/2
+ # -inf result is -PI/2
+ # calculate PI/2
+ my $pi = $class->bpi(@r);
+ # modify $self in place
+ $self->{_m} = $pi->{_m};
+ $self->{_e} = $pi->{_e};
+ $self->{_es} = $pi->{_es};
+ # -y => -PI/2, +y => PI/2
+ $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+"
+ $MBI->_div($self->{_m}, $MBI->_new(2));
+ return $self;
}
- # when user set globals, they would interfere with our calculation, so
- # disable them and later re-enable them
- no strict 'refs';
- my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
- # we also need to disable any set A or P on $x (_find_round_parameters took
- # them already into account), since these would interfere, too
- delete $x->{_a}; delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef;
-
- my $last = 0;
- my $over = $x * $x; # X ^ 2
- my $x2 = $over->copy(); # X ^ 2; difference between terms
- $over->bmul($x); # X ^ 3 as starting value
- my $sign = 1; # start with -=
- my $below = $self->new(3);
- my $two = $self->new(2);
- delete $x->{_a}; delete $x->{_p};
+ return $self->bzero(@r) if $self->is_zero();
- my $limit = $self->new("1E-". ($scale-1));
- #my $steps = 0;
- while (3 < 5)
- {
- # we calculate the next term, and add it to the last
- # when the next term is below our limit, it won't affect the outcome
- # anymore, so we stop:
- my $next = $over->copy()->bdiv($below,$scale);
- last if $next->bacmp($limit) <= 0;
-
- if ($sign == 0)
- {
- $x->badd($next);
- }
- else
- {
- $x->bsub($next);
- }
- $sign = 1-$sign; # alternate
- # calculate things for the next term
- $over->bmul($x2); # $x*$x
- $below->badd($two); # n += 2
+ # no rounding at all, so must use fallback
+ if (scalar @params == 0) {
+ # simulate old behaviour
+ $params[0] = $class->div_scale(); # and round to it as accuracy
+ $params[1] = undef; # disable P
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r[2]; # round mode by caller or undef
+ $fallback = 1; # to clear a/p afterwards
+ } else {
+ # the 4 below is empirical, and there might be cases where it is not
+ # enough...
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
- if (defined $pi)
- {
- my $x_copy = $x->copy();
- # modify $x in place
- $x->{_m} = $pi->{_m};
- $x->{_e} = $pi->{_e};
- $x->{_es} = $pi->{_es};
- # PI/2 - $x
- $x->bsub($x_copy);
+ # 1 or -1 => PI/4
+ # inlined is_one() && is_one('-')
+ if ($MBI->_is_one($self->{_m}) && $MBI->_is_zero($self->{_e})) {
+ my $pi = $class->bpi($scale - 3);
+ # modify $self in place
+ $self->{_m} = $pi->{_m};
+ $self->{_e} = $pi->{_e};
+ $self->{_es} = $pi->{_es};
+ # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4)
+ $MBI->_div($self->{_m}, $MBI->_new(4));
+ return $self;
}
- # shortcut to not run through _find_round_parameters again
- if (defined $params[0])
- {
- $x->bround($params[0],$params[2]); # then round accordingly
- }
- else
- {
- $x->bfround($params[1],$params[2]); # then round accordingly
+ # This series is only valid if -1 < x < 1, so for other x we need to
+ # calculate PI/2 - atan(1/x):
+ my $one = $MBI->_new(1);
+ my $pi = undef;
+ if ($self->bacmp($self->copy->bone) >= 0) {
+ # calculate PI/2
+ $pi = $class->bpi($scale - 3);
+ $MBI->_div($pi->{_m}, $MBI->_new(2));
+ # calculate 1/$self:
+ my $self_copy = $self->copy();
+ # modify $self in place
+ $self->bone(); $self->bdiv($self_copy, $scale);
+ }
+
+ my $fmul = 1;
+ foreach my $k (0 .. int($scale / 20)) {
+ $fmul *= 2;
+ $self->bdiv($self->copy->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4);
+ }
+
+ # When user set globals, they would interfere with our calculation, so
+ # disable them and later re-enable them.
+ no strict 'refs';
+ my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
+ my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ # We also need to disable any set A or P on $self (_find_round_parameters
+ # took them already into account), since these would interfere, too
+ delete $self->{_a}; delete $self->{_p};
+ # Need to disable $upgrade in BigInt, to avoid deep recursion.
+ local $Math::BigInt::upgrade = undef;
+
+ my $last = 0;
+ my $over = $self * $self; # X ^ 2
+ my $self2 = $over->copy(); # X ^ 2; difference between terms
+ $over->bmul($self); # X ^ 3 as starting value
+ my $sign = 1; # start with -=
+ my $below = $class->new(3);
+ my $two = $class->new(2);
+ delete $self->{_a}; delete $self->{_p};
+
+ my $limit = $class->new("1E-". ($scale-1));
+ #my $steps = 0;
+ while (1) {
+ # We calculate the next term, and add it to the last. When the next
+ # term is below our limit, it won't affect the outcome anymore, so we
+ # stop:
+ my $next = $over->copy()->bdiv($below, $scale);
+ last if $next->bacmp($limit) <= 0;
+
+ if ($sign == 0) {
+ $self->badd($next);
+ } else {
+ $self->bsub($next);
+ }
+ $sign = 1-$sign; # alternatex
+ # calculate things for the next term
+ $over->bmul($self2); # $self*$self
+ $below->badd($two); # n += 2
+ }
+ $self->bmul($fmul);
+
+ if (defined $pi) {
+ my $self_copy = $self->copy();
+ # modify $self in place
+ $self->{_m} = $pi->{_m};
+ $self->{_e} = $pi->{_e};
+ $self->{_es} = $pi->{_es};
+ # PI/2 - $self
+ $self->bsub($self_copy);
+ }
+
+ # Shortcut to not run through _find_round_parameters again.
+ if (defined $params[0]) {
+ $self->bround($params[0], $params[2]); # then round accordingly
+ } else {
+ $self->bfround($params[1], $params[2]); # then round accordingly
}
- if ($fallback)
- {
- # clear a/p after round, since user did not request it
- delete $x->{_a}; delete $x->{_p};
+ if ($fallback) {
+ # Clear a/p after round, since user did not request it.
+ delete $self->{_a}; delete $self->{_p};
}
- # restore globals
- $$abr = $ab; $$pbr = $pb;
- $x;
- }
+
+ # restore globals
+ $$abr = $ab; $$pbr = $pb;
+ $self;
+}
###############################################################################
# rounding functions
@@ -4014,6 +4030,8 @@ sub from_hex {
my $str = shift;
+ # If called as a class method, initialize a new object.
+
$self = $class -> bzero() unless $selfref;
if ($str =~ s/
@@ -4061,9 +4079,9 @@ sub from_hex {
# If there is a dot in the significand, remove it and adjust the
# exponent according to the number of digits in the fraction part of
- # the significand. Multiply the exponent adjustment value by 4 since
- # the digits in the significand are in base 16, but the exponent is
- # only in base 2.
+ # the significand. Since the digits in the significand are in base 16,
+ # but the exponent is only in base 2, multiply the exponent adjustment
+ # value by log(16) / log(2) = 4.
my $idx = index($s_value, '.');
if ($idx >= 0) {
@@ -4090,6 +4108,170 @@ sub from_hex {
return $self->bnan();
}
+sub from_oct {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
+
+ if ($str =~ s/
+ ^
+
+ # sign
+ ( [+-]? )
+
+ # significand using the octal digits 0..7
+ (
+ [0-7]+ (?: _ [0-7]+ )*
+ (?:
+ \.
+ (?: [0-7]+ (?: _ [0-7]+ )* )?
+ )?
+ |
+ \.
+ [0-7]+ (?: _ [0-7]+ )*
+ )
+
+ # exponent (power of 2) using decimal digits
+ (?:
+ [Pp]
+ ( [+-]? )
+ ( \d+ (?: _ \d+ )* )
+ )?
+
+ $
+ //x)
+ {
+ my $s_sign = $1 || '+';
+ my $s_value = $2;
+ my $e_sign = $3 || '+';
+ my $e_value = $4 || '0';
+ $s_value =~ tr/_//d;
+ $e_value =~ tr/_//d;
+
+ # The significand must be multiplied by 2 raised to this exponent.
+
+ my $two_expon = $class -> new($e_value);
+ $two_expon -> bneg() if $e_sign eq '-';
+
+ # If there is a dot in the significand, remove it and adjust the
+ # exponent according to the number of digits in the fraction part of
+ # the significand. Since the digits in the significand are in base 8,
+ # but the exponent is only in base 2, multiply the exponent adjustment
+ # value by log(8) / log(2) = 3.
+
+ my $idx = index($s_value, '.');
+ if ($idx >= 0) {
+ substr($s_value, $idx, 1) = '';
+ $two_expon -= $class -> new(CORE::length($s_value))
+ -> bsub($idx)
+ -> bmul("3");
+ }
+
+ $self -> {sign} = $s_sign;
+ $self -> {_m} = $MBI -> _from_oct($s_value);
+
+ if ($two_expon > 0) {
+ my $factor = $class -> new("2") -> bpow($two_expon);
+ $self -> bmul($factor);
+ } elsif ($two_expon < 0) {
+ my $factor = $class -> new("0.5") -> bpow(-$two_expon);
+ $self -> bmul($factor);
+ }
+
+ return $self;
+ }
+
+ return $self->bnan();
+}
+
+sub from_bin {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
+
+ if ($str =~ s/
+ ^
+
+ # sign
+ ( [+-]? )
+
+ # optional "bin marker"
+ (?: 0? b )?
+
+ # significand using the binary digits 0 and 1
+ (
+ [01]+ (?: _ [01]+ )*
+ (?:
+ \.
+ (?: [01]+ (?: _ [01]+ )* )?
+ )?
+ |
+ \.
+ [01]+ (?: _ [01]+ )*
+ )
+
+ # exponent (power of 2) using decimal digits
+ (?:
+ [Pp]
+ ( [+-]? )
+ ( \d+ (?: _ \d+ )* )
+ )?
+
+ $
+ //x)
+ {
+ my $s_sign = $1 || '+';
+ my $s_value = $2;
+ my $e_sign = $3 || '+';
+ my $e_value = $4 || '0';
+ $s_value =~ tr/_//d;
+ $e_value =~ tr/_//d;
+
+ # The significand must be multiplied by 2 raised to this exponent.
+
+ my $two_expon = $class -> new($e_value);
+ $two_expon -> bneg() if $e_sign eq '-';
+
+ # If there is a dot in the significand, remove it and adjust the
+ # exponent according to the number of digits in the fraction part of
+ # the significand.
+
+ my $idx = index($s_value, '.');
+ if ($idx >= 0) {
+ substr($s_value, $idx, 1) = '';
+ $two_expon -= $class -> new(CORE::length($s_value))
+ -> bsub($idx);
+ }
+
+ $self -> {sign} = $s_sign;
+ $self -> {_m} = $MBI -> _from_bin('0b' . $s_value);
+
+ if ($two_expon > 0) {
+ my $factor = $class -> new("2") -> bpow($two_expon);
+ $self -> bmul($factor);
+ } elsif ($two_expon < 0) {
+ my $factor = $class -> new("0.5") -> bpow(-$two_expon);
+ $self -> bmul($factor);
+ }
+
+ return $self;
+ }
+
+ return $self->bnan();
+}
+
1;
__END__
@@ -4115,7 +4297,9 @@ Math::BigFloat - Arbitrary size floating point math package
my $mone = Math::BigFloat->bone('-'); # create a -1
my $x = Math::BigFloat->bone('-'); #
- my $h = Math::BigFloat->from_hex('0xc.afep+3'); # from hexadecimal
+ my $x = Math::BigFloat->from_hex('0xc.afep+3'); # from hexadecimal
+ my $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
+ my $x = Math::BigFloat->from_oct('1.3267p-4'); # from octal
my $pi = Math::BigFloat->bpi(100); # PI to 100 digits
@@ -4587,9 +4771,33 @@ In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
$x -> from_hex("0x1.921fb54442d18p+1");
$x = Math::BigFloat -> from_hex("0x1.921fb54442d18p+1");
-Interpret input as a hexadecimal string. A "0x" or "x" prefix is optional. A
-single underscore character may be placed between any two digits. If the input
-is invalid, a NaN is returned. The exponent is in base 2 using decimal digits.
+Interpret input as a hexadecimal string.A prefix ("0x", "x", ignoring case) is
+optional. A single underscore character ("_") may be placed between any two
+digits. If the input is invalid, a NaN is returned. The exponent is in base 2
+using decimal digits.
+
+If called as an instance method, the value is assigned to the invocand.
+
+=item from_bin()
+
+ $x -> from_bin("0b1.1001p-4");
+ $x = Math::BigFloat -> from_bin("0b1.1001p-4");
+
+Interpret input as a hexadecimal string. A prefix ("0b" or "b", ignoring case)
+is optional. A single underscore character ("_") may be placed between any two
+digits. If the input is invalid, a NaN is returned. The exponent is in base 2
+using decimal digits.
+
+If called as an instance method, the value is assigned to the invocand.
+
+=item from_oct()
+
+ $x -> from_oct("1.3267p-4");
+ $x = Math::BigFloat -> from_oct("1.3267p-4");
+
+Interpret input as an octal string. A single underscore character ("_") may be
+placed between any two digits. If the input is invalid, a NaN is returned. The
+exponent is in base 2 using decimal digits.
If called as an instance method, the value is assigned to the invocand.
diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm
index 23f9401f1b..a4f857f1db 100644
--- a/cpan/Math-BigInt/lib/Math/BigInt.pm
+++ b/cpan/Math-BigInt/lib/Math/BigInt.pm
@@ -15,11 +15,12 @@ package Math::BigInt;
# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
# underlying lib might change the reference!
-use 5.006002;
+use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999710';
+our $VERSION = '1.999714';
+$VERSION = eval $VERSION;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(objectify bgcd blcm);
@@ -50,101 +51,101 @@ use overload
# some shortcuts for speed (assumes that reversed order of arguments is routed
# to normal '+' and we thus can always modify first arg. If this is changed,
# this breaks and must be adjusted.)
-'+=' => sub { $_[0]->badd($_[1]); },
-'-=' => sub { $_[0]->bsub($_[1]); },
-'*=' => sub { $_[0]->bmul($_[1]); },
-'/=' => sub { scalar $_[0]->bdiv($_[1]); },
-'%=' => sub { $_[0]->bmod($_[1]); },
-'^=' => sub { $_[0]->bxor($_[1]); },
-'&=' => sub { $_[0]->band($_[1]); },
-'|=' => sub { $_[0]->bior($_[1]); },
-
-'**=' => sub { $_[0]->bpow($_[1]); },
-'<<=' => sub { $_[0]->blsft($_[1]); },
-'>>=' => sub { $_[0]->brsft($_[1]); },
+'+=' => sub { $_[0]->badd($_[1]); },
+'-=' => sub { $_[0]->bsub($_[1]); },
+'*=' => sub { $_[0]->bmul($_[1]); },
+'/=' => sub { scalar $_[0]->bdiv($_[1]); },
+'%=' => sub { $_[0]->bmod($_[1]); },
+'^=' => sub { $_[0]->bxor($_[1]); },
+'&=' => sub { $_[0]->band($_[1]); },
+'|=' => sub { $_[0]->bior($_[1]); },
+
+'**=' => sub { $_[0]->bpow($_[1]); },
+'<<=' => sub { $_[0]->blsft($_[1]); },
+'>>=' => sub { $_[0]->brsft($_[1]); },
# not supported by Perl yet
-'..' => \&_pointpoint,
-
-'<=>' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
- $_[0]->bcmp($_[1]);
- $rc = 1 unless defined $rc;
- $rc <=> 0;
- },
+'..' => \&_pointpoint,
+
+'<=>' => sub { my $rc = $_[2] ?
+ ref($_[0])->bcmp($_[1],$_[0]) :
+ $_[0]->bcmp($_[1]);
+ $rc = 1 unless defined $rc;
+ $rc <=> 0;
+ },
# we need '>=' to get things like "1 >= NaN" right:
-'>=' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
+'>=' => sub { my $rc = $_[2] ?
+ ref($_[0])->bcmp($_[1],$_[0]) :
$_[0]->bcmp($_[1]);
- # if there was a NaN involved, return false
- return '' unless defined $rc;
- $rc >= 0;
- },
-'cmp' => sub {
- $_[2] ?
+ # if there was a NaN involved, return false
+ return '' unless defined $rc;
+ $rc >= 0;
+ },
+'cmp' => sub {
+ $_[2] ?
"$_[1]" cmp $_[0]->bstr() :
$_[0]->bstr() cmp "$_[1]" },
-'cos' => sub { $_[0]->copy->bcos(); },
-'sin' => sub { $_[0]->copy->bsin(); },
-'atan2' => sub { $_[2] ?
- ref($_[0])->new($_[1])->batan2($_[0]) :
- $_[0]->copy()->batan2($_[1]) },
+'cos' => sub { $_[0]->copy->bcos(); },
+'sin' => sub { $_[0]->copy->bsin(); },
+'atan2' => sub { $_[2] ?
+ ref($_[0])->new($_[1])->batan2($_[0]) :
+ $_[0]->copy()->batan2($_[1]) },
# are not yet overloadable
-#'hex' => sub { print "hex"; $_[0]; },
-#'oct' => sub { print "oct"; $_[0]; },
+#'hex' => sub { print "hex"; $_[0]; },
+#'oct' => sub { print "oct"; $_[0]; },
# log(N) is log(N, e), where e is Euler's number
-'log' => sub { $_[0]->copy()->blog(); },
-'exp' => sub { $_[0]->copy()->bexp($_[1]); },
-'int' => sub { $_[0]->copy(); },
-'neg' => sub { $_[0]->copy()->bneg(); },
-'abs' => sub { $_[0]->copy()->babs(); },
-'sqrt' => sub { $_[0]->copy()->bsqrt(); },
-'~' => sub { $_[0]->copy()->bnot(); },
+'log' => sub { $_[0]->copy()->blog(); },
+'exp' => sub { $_[0]->copy()->bexp($_[1]); },
+'int' => sub { $_[0]->copy(); },
+'neg' => sub { $_[0]->copy()->bneg(); },
+'abs' => sub { $_[0]->copy()->babs(); },
+'sqrt' => sub { $_[0]->copy()->bsqrt(); },
+'~' => sub { $_[0]->copy()->bnot(); },
# for subtract it's a bit tricky to not modify b: b-a => -a+b
-'-' => sub { my $c = $_[0]->copy; $_[2] ?
- $c->bneg()->badd( $_[1]) :
- $c->bsub( $_[1]) },
-'+' => sub { $_[0]->copy()->badd($_[1]); },
-'*' => sub { $_[0]->copy()->bmul($_[1]); },
+'-' => sub { my $c = $_[0]->copy; $_[2] ?
+ $c->bneg()->badd( $_[1]) :
+ $c->bsub( $_[1]) },
+'+' => sub { $_[0]->copy()->badd($_[1]); },
+'*' => sub { $_[0]->copy()->bmul($_[1]); },
-'/' => sub {
+'/' => sub {
$_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]);
- },
-'%' => sub {
+ },
+'%' => sub {
$_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]);
- },
-'**' => sub {
+ },
+'**' => sub {
$_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]);
- },
-'<<' => sub {
+ },
+'<<' => sub {
$_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]);
- },
-'>>' => sub {
+ },
+'>>' => sub {
$_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]);
- },
-'&' => sub {
+ },
+'&' => sub {
$_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]);
- },
-'|' => sub {
+ },
+'|' => sub {
$_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]);
- },
-'^' => sub {
+ },
+'^' => sub {
$_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]);
- },
+ },
# can modify arg of ++ and --, so avoid a copy() for speed, but don't
# use $_[0]->bone(), it would modify $_[0] to be 1!
-'++' => sub { $_[0]->binc() },
-'--' => sub { $_[0]->bdec() },
+'++' => sub { $_[0]->binc() },
+'--' => sub { $_[0]->bdec() },
# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
-'bool' => sub {
+'bool' => sub {
# this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
- # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
+ # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
my $t = undef;
$t = 1 if !$_[0]->is_zero();
$t;
@@ -168,23 +169,23 @@ $accuracy = undef;
$precision = undef;
$div_scale = 40;
-$upgrade = undef; # default is no upgrade
-$downgrade = undef; # default is no downgrade
+$upgrade = undef; # default is no upgrade
+$downgrade = undef; # default is no downgrade
# These are internally, and not to be used from the outside at all
-$_trap_nan = 0; # are NaNs ok? set w/ config()
-$_trap_inf = 0; # are infs ok? set w/ config()
-my $nan = 'NaN'; # constants for easier life
+$_trap_nan = 0; # are NaNs ok? set w/ config()
+$_trap_inf = 0; # are infs ok? set w/ config()
+my $nan = 'NaN'; # constants for easier life
-my $CALC = 'Math::BigInt::Calc'; # module to do the low level math
- # default is Calc.pm
-my $IMPORT = 0; # was import() called yet?
- # used to make require work
-my %WARN; # warn only once for low-level libs
-my %CAN; # cache for $CALC->can(...)
-my %CALLBACKS; # callbacks to notify on lib loads
-my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
+my $CALC = 'Math::BigInt::Calc'; # module to do the low level math
+ # default is Calc.pm
+my $IMPORT = 0; # was import() called yet?
+ # used to make require work
+my %WARN; # warn only once for low-level libs
+my %CAN; # cache for $CALC->can(...)
+my %CALLBACKS; # callbacks to notify on lib loads
+my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
@@ -195,9 +196,9 @@ sub FETCH { return $round_mode; }
sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
BEGIN
- {
+ {
# tie to enable $rnd_mode to work transparently
- tie $rnd_mode, 'Math::BigInt';
+ tie $rnd_mode, 'Math::BigInt';
# set up some handy alias names
*as_int = \&as_number;
@@ -205,7 +206,7 @@ BEGIN
*is_neg = \&is_negative;
}
-##############################################################################
+##############################################################################
sub round_mode
{
@@ -272,10 +273,10 @@ sub div_scale
sub accuracy
{
- # $x->accuracy($a); ref($x) $a
- # $x->accuracy(); ref($x)
- # Class->accuracy(); class
- # Class->accuracy($a); class $a
+ # $x->accuracy($a); ref($x) $a
+ # $x->accuracy(); ref($x)
+ # Class->accuracy(); class
+ # Class->accuracy($a); class $a
my $x = shift;
my $class = ref($x) || $x || __PACKAGE__;
@@ -296,28 +297,28 @@ sub accuracy
if (!$a || $a <= 0)
{
require Carp;
- Carp::croak ('Argument to accuracy must be greater than zero');
+ Carp::croak ('Argument to accuracy must be greater than zero');
}
if (int($a) != $a)
{
require Carp;
- Carp::croak ('Argument to accuracy must be an integer');
+ Carp::croak ('Argument to accuracy must be an integer');
}
}
if (ref($x))
{
# $object->accuracy() or fallback to global
- $x->bround($a) if $a; # not for undef, 0
- $x->{_a} = $a; # set/overwrite, even if not rounded
- delete $x->{_p}; # clear P
+ $x->bround($a) if $a; # not for undef, 0
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ delete $x->{_p}; # clear P
$a = ${"${class}::accuracy"} unless defined $a; # proper return value
}
else
{
- ${"${class}::accuracy"} = $a; # set global A
- ${"${class}::precision"} = undef; # clear global P
+ ${"${class}::accuracy"} = $a; # set global A
+ ${"${class}::precision"} = undef; # clear global P
}
- return $a; # shortcut
+ return $a; # shortcut
}
my $a;
@@ -330,10 +331,10 @@ sub accuracy
sub precision
{
- # $x->precision($p); ref($x) $p
- # $x->precision(); ref($x)
- # Class->precision(); class
- # Class->precision($p); class $p
+ # $x->precision($p); ref($x) $p
+ # $x->precision(); ref($x)
+ # Class->precision(); class
+ # Class->precision($p); class $p
my $x = shift;
my $class = ref($x) || $x || __PACKAGE__;
@@ -353,17 +354,17 @@ sub precision
if (ref($x))
{
# $object->precision() or fallback to global
- $x->bfround($p) if $p; # not for undef, 0
- $x->{_p} = $p; # set/overwrite, even if not rounded
- delete $x->{_a}; # clear A
+ $x->bfround($p) if $p; # not for undef, 0
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ delete $x->{_a}; # clear A
$p = ${"${class}::precision"} unless defined $p; # proper return value
}
else
{
- ${"${class}::precision"} = $p; # set global P
- ${"${class}::accuracy"} = undef; # clear global A
+ ${"${class}::precision"} = $p; # set global P
+ ${"${class}::accuracy"} = undef; # clear global A
}
- return $p; # shortcut
+ return $p; # shortcut
}
my $p;
@@ -442,7 +443,7 @@ sub config
}
sub _scale_a
- {
+ {
# select accuracy parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
my ($x,$scale,$mode) = @_;
@@ -466,7 +467,7 @@ sub _scale_a
}
sub _scale_p
- {
+ {
# select precision parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
my ($x,$scale,$mode) = @_;
@@ -492,170 +493,191 @@ sub _scale_p
##############################################################################
# constructors
-sub copy
- {
- # if two arguments, the first one is the class to "swallow" subclasses
- if (@_ > 1)
- {
- my $self = bless {
- sign => $_[1]->{sign},
- value => $CALC->_copy($_[1]->{value}),
- }, $_[0] if @_ > 1;
+sub copy {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
- $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
- return $self;
- }
+ # If called as a class method, the object to copy is the next argument.
- my $self = bless {
- sign => $_[0]->{sign},
- value => $CALC->_copy($_[0]->{value}),
- }, ref($_[0]);
+ $self = shift() unless $selfref;
- $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
- $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
- $self;
- }
+ my $copy = bless {}, $class;
-sub new
- {
- # create a new BigInt object from a string or another BigInt object.
- # see hash keys documented at top
+ $copy->{sign} = $self->{sign};
+ $copy->{value} = $CALC->_copy($self->{value});
+ $copy->{_a} = $self->{_a} if exists $self->{_a};
+ $copy->{_p} = $self->{_p} if exists $self->{_p};
- # the argument could be an object, so avoid ||, && etc on it, this would
- # cause costly overloaded code to be called. The only allowed ops are
- # ref() and defined.
+ return $copy;
+}
- my ($class,$wanted,$a,$p,$r) = @_;
+sub new {
+ # Create a new Math::BigInt object from a string or another Math::BigInt
+ # object. See hash keys documented at top.
- # avoid numify-calls by not using || on $wanted!
- return $class->bzero($a,$p) if !defined $wanted; # default to 0
- return $class->copy($wanted,$a,$p,$r)
- if ref($wanted) && $wanted->isa($class); # MBI or subclass
+ # The argument could be an object, so avoid ||, && etc. on it. This would
+ # cause costly overloaded code to be called. The only allowed ops are ref()
+ # and defined.
- $class->import() if $IMPORT == 0; # make require work
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my $self = bless {}, $class;
+ my ($wanted, $a, $p, $r) = @_;
- # shortcut for "normal" numbers
- if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
- {
- $self->{sign} = $1 || '+';
+ # If called as a class method, initialize a new object.
- if ($wanted =~ /^[+-]/)
- {
- # remove sign without touching wanted to make it work with constants
- my $t = $wanted; $t =~ s/^[+-]//;
- $self->{value} = $CALC->_new($t);
- }
- else
- {
- $self->{value} = $CALC->_new($wanted);
- }
- no strict 'refs';
- if ( (defined $a) || (defined $p)
- || (defined ${"${class}::precision"})
- || (defined ${"${class}::accuracy"})
- )
- {
- $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
- }
- return $self;
- }
+ $self = bless {}, $class unless $selfref;
- # handle '+inf', '-inf' first
- if ($wanted =~ /^[+-]?inf\z/)
- {
- $self->{sign} = $wanted; # set a default sign for bstr()
- return $self->binf($wanted);
- }
- # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
- my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
- if (!ref $mis)
- {
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted is not a number in $class");
- }
- $self->{value} = $CALC->_zero();
- $self->{sign} = $nan;
- return $self;
+ unless (defined $wanted) {
+ require Carp;
+ Carp::carp("Use of uninitialized value in new");
+ return $self->bzero($a, $p, $r);
}
- if (!ref $miv)
- {
- # _from_hex or _from_bin
- $self->{value} = $mis->{value};
- $self->{sign} = $mis->{sign};
- return $self; # throw away $mis
- }
- # make integer from mantissa by adjusting exp, then convert to bigint
- $self->{sign} = $$mis; # store sign
- $self->{value} = $CALC->_zero(); # for all the NaN cases
- my $e = int("$$es$$ev"); # exponent (avoid recursion)
- if ($e > 0)
- {
- my $diff = $e - CORE::length($$mfv);
- if ($diff < 0) # Not integer
- {
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted not an integer in $class");
+
+ if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass
+ # Using "$copy = $wanted -> copy()" here fails some tests. Fixme!
+ my $copy = $class -> copy($wanted);
+ if ($selfref) {
+ %$self = %$copy;
+ } else {
+ $self = $copy;
}
- #print "NOI 1\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
- $self->{sign} = $nan;
- }
- else # diff >= 0
- {
- # adjust fraction and add it to value
- #print "diff > 0 $$miv\n";
- $$miv = $$miv . ($$mfv . '0' x $diff);
- }
+ return $self;
}
- else
+
+ $class->import() if $IMPORT == 0; # make require work
+
+ # Shortcut for non-zero scalar integers with no non-zero exponent.
+
+ if (!ref($wanted) &&
+ $wanted =~ / ^
+ ([+-]?) # optional sign
+ ([1-9][0-9]*) # non-zero significand
+ (\.0*)? # ... with optional zero fraction
+ ([Ee][+-]?0+)? # optional zero exponent
+ \z
+ /x)
{
- if ($$mfv ne '') # e <= 0
- {
- # fraction and negative/zero E => NOI
- if ($_trap_nan)
+ my $sgn = $1;
+ my $abs = $2;
+ $self->{sign} = $sgn || '+';
+ $self->{value} = $CALC->_new($abs);
+
+ no strict 'refs';
+ if (defined($a) || defined($p)
+ || defined(${"${class}::precision"})
+ || defined(${"${class}::accuracy"}))
{
- require Carp; Carp::croak("$wanted not an integer in $class");
+ $self->round($a, $p, $r)
+ unless @_ == 4 && !defined $a && !defined $p;
}
- #print "NOI 2 \$\$mfv '$$mfv'\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
- $self->{sign} = $nan;
- }
- elsif ($e < 0)
- {
- # xE-y, and empty mfv
- # Split the mantissa at the decimal point. E.g., if
- # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123.
- my $frac = substr($$miv, $e); # $frac is fraction part
- substr($$miv, $e) = ""; # $$miv is now integer part
+ return $self;
+ }
+
+ # Handle Infs.
- if ($frac =~ /[^0]/)
- {
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted not an integer in $class");
- }
- #print "NOI 3\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
+ if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
+ my $sgn = $1 || '+';
+ $self->{sign} = $sgn . 'inf'; # set a default sign for bstr()
+ return $self->binf($sgn);
+ }
+
+ # Handle explicit NaNs (not the ones returned due to invalid input).
+
+ if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
+ return $self->bnan();
+ }
+
+ if ($wanted =~ /^\s*[+-]?0[Xx]/) {
+ return $class -> from_hex($wanted);
+ }
+
+ if ($wanted =~ /^\s*[+-]?0[Bb]/) {
+ return $class -> from_bin($wanted);
+ }
+
+ # Split string into mantissa, exponent, integer, fraction, value, and sign.
+ my ($mis, $miv, $mfv, $es, $ev) = _split($wanted);
+ if (!ref $mis) {
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted is not a number in $class");
+ }
+ $self->{value} = $CALC->_zero();
$self->{sign} = $nan;
+ return $self;
+ }
+
+ if (!ref $miv) {
+ # _from_hex or _from_bin
+ $self->{value} = $mis->{value};
+ $self->{sign} = $mis->{sign};
+ return $self; # throw away $mis
+ }
+
+ # Make integer from mantissa by adjusting exponent, then convert to a
+ # Math::BigInt.
+ $self->{sign} = $$mis; # store sign
+ $self->{value} = $CALC->_zero(); # for all the NaN cases
+ my $e = int("$$es$$ev"); # exponent (avoid recursion)
+ if ($e > 0) {
+ my $diff = $e - CORE::length($$mfv);
+ if ($diff < 0) { # Not integer
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 1\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ } else { # diff >= 0
+ # adjust fraction and add it to value
+ #print "diff > 0 $$miv\n";
+ $$miv = $$miv . ($$mfv . '0' x $diff);
}
- }
}
- unless ($self->{sign} eq $nan) {
- $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
- }
- # if any of the globals is set, use them to round and store them inside $self
- # do not round for new($x,undef,undef) since that is used by MBF to signal
- # no rounding
- $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
- $self;
- }
+
+ else {
+ if ($$mfv ne '') { # e <= 0
+ # fraction and negative/zero E => NOI
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 2 \$\$mfv '$$mfv'\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ } elsif ($e < 0) {
+ # xE-y, and empty mfv
+ # Split the mantissa at the decimal point. E.g., if
+ # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123.
+
+ my $frac = substr($$miv, $e); # $frac is fraction part
+ substr($$miv, $e) = ""; # $$miv is now integer part
+
+ if ($frac =~ /[^0]/) {
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 3\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ }
+ }
+ }
+
+ unless ($self->{sign} eq $nan) {
+ $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
+ $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
+ }
+
+ # If any of the globals are set, use them to round, and store them inside
+ # $self. Do not round for new($x, undef, undef) since that is used by MBF
+ # to signal no rounding.
+
+ $self->round($a, $p, $r) unless @_ == 4 && !defined $a && !defined $p;
+ $self;
+}
sub bnan
{
@@ -672,7 +694,7 @@ sub bnan
require Carp;
Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bnan');
if ($self->can('_bnan'))
{
@@ -685,7 +707,7 @@ sub bnan
$self->{value} = $CALC->_zero();
}
$self->{sign} = $nan;
- delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
+ delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
$self;
}
@@ -706,7 +728,7 @@ sub binf
require Carp;
Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('binf');
if ($self->can('_binf'))
{
@@ -718,9 +740,9 @@ sub binf
# otherwise do our own thing
$self->{value} = $CALC->_zero();
}
- $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
+ $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
$self->{sign} = $sign;
- ($self->{_a},$self->{_p}) = @_; # take over requested rounding
+ ($self->{_a},$self->{_p}) = @_; # take over requested rounding
$self;
}
@@ -734,7 +756,7 @@ sub bzero
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bzero');
if ($self->can('_bzero'))
@@ -778,7 +800,7 @@ sub bone
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bone');
if ($self->can('_bone'))
@@ -819,34 +841,34 @@ sub bsstr
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to scientific string format.
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
my ($m,$e) = $x->parts();
- #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
+ #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
# 'e+' because E can only be positive in BigInt
- $m->bstr() . 'e+' . $CALC->_str($e->{value});
+ $m->bstr() . 'e+' . $CALC->_str($e->{value});
}
-sub bstr
+sub bstr
{
# make a string from bigint object
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
$es.$CALC->_str($x->{value});
}
-sub numify
+sub numify
{
# Make a Perl scalar number from a Math::BigInt object.
my $x = shift; $x = $class->new($x) unless ref $x;
@@ -873,158 +895,146 @@ sub numify
sub sign
{
# return the sign of the number: +/-/-inf/+inf/NaN
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x->{sign};
}
-sub _find_round_parameters
- {
- # After any operation or when calling round(), the result is rounded by
- # regarding the A & P from arguments, local parameters, or globals.
+sub _find_round_parameters {
+ # After any operation or when calling round(), the result is rounded by
+ # regarding the A & P from arguments, local parameters, or globals.
- # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
+ # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
- # This procedure finds the round parameters, but it is for speed reasons
- # duplicated in round. Otherwise, it is tested by the testsuite and used
- # by bdiv().
+ # This procedure finds the round parameters, but it is for speed reasons
+ # duplicated in round. Otherwise, it is tested by the testsuite and used
+ # by bdiv().
- # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
- # were requested/defined (locally or globally or both)
+ # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
+ # were requested/defined (locally or globally or both)
- my ($self,$a,$p,$r,@args) = @_;
- # $a accuracy, if given by caller
- # $p precision, if given by caller
- # $r round_mode, if given by caller
- # @args all 'other' arguments (0 for unary, 1 for binary ops)
+ my ($self, $a, $p, $r, @args) = @_;
+ # $a accuracy, if given by caller
+ # $p precision, if given by caller
+ # $r round_mode, if given by caller
+ # @args all 'other' arguments (0 for unary, 1 for binary ops)
- my $c = ref($self); # find out class of argument(s)
- no strict 'refs';
+ my $class = ref($self); # find out class of argument(s)
+ no strict 'refs';
- # convert to normal scalar for speed and correctness in inner parts
- $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
- $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
+ # convert to normal scalar for speed and correctness in inner parts
+ $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
+ $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
- # now pick $a or $p, but only if we have got "arguments"
- if (!defined $a)
- {
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
- }
+ # now pick $a or $p, but only if we have got "arguments"
+ if (!defined $a) {
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is smaller
+ $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ }
}
- if (!defined $p)
- {
- # even if $a is defined, take $p, to signal error for both defined
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is bigger
- # -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
- }
+ if (!defined $p) {
+ # even if $a is defined, take $p, to signal error for both defined
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is bigger
+ # -2 > -3, and 3 > 2
+ $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ }
}
- # if still none defined, use globals (#2)
- $a = ${"$c\::accuracy"} unless defined $a;
- $p = ${"$c\::precision"} unless defined $p;
- # A == 0 is useless, so undef it to signal no rounding
- $a = undef if defined $a && $a == 0;
+ # if still none defined, use globals (#2)
+ $a = ${"$class\::accuracy"} unless defined $a;
+ $p = ${"$class\::precision"} unless defined $p;
- # no rounding today?
- return ($self) unless defined $a || defined $p; # early out
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
- # set A and set P is an fatal error
- return ($self->bnan()) if defined $a && defined $p; # error
+ # no rounding today?
+ return ($self) unless defined $a || defined $p; # early out
- $r = ${"$c\::round_mode"} unless defined $r;
- if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
- {
- require Carp; Carp::croak ("Unknown round mode '$r'");
+ # set A and set P is an fatal error
+ return ($self->bnan()) if defined $a && defined $p; # error
+
+ $r = ${"$class\::round_mode"} unless defined $r;
+ if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
- $a = int($a) if defined $a;
- $p = int($p) if defined $p;
+ $a = int($a) if defined $a;
+ $p = int($p) if defined $p;
- ($self,$a,$p,$r);
- }
+ ($self, $a, $p, $r);
+}
-sub round
- {
- # Round $self according to given parameters, or given second argument's
- # parameters or global defaults
+sub round {
+ # Round $self according to given parameters, or given second argument's
+ # parameters or global defaults
- # for speed reasons, _find_round_parameters is embedded here:
+ # for speed reasons, _find_round_parameters is embedded here:
- my ($self,$a,$p,$r,@args) = @_;
- # $a accuracy, if given by caller
- # $p precision, if given by caller
- # $r round_mode, if given by caller
- # @args all 'other' arguments (0 for unary, 1 for binary ops)
+ my ($self, $a, $p, $r, @args) = @_;
+ # $a accuracy, if given by caller
+ # $p precision, if given by caller
+ # $r round_mode, if given by caller
+ # @args all 'other' arguments (0 for unary, 1 for binary ops)
- my $c = ref($self); # find out class of argument(s)
- no strict 'refs';
+ my $class = ref($self); # find out class of argument(s)
+ no strict 'refs';
- # now pick $a or $p, but only if we have got "arguments"
- if (!defined $a)
- {
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
- }
+ # now pick $a or $p, but only if we have got "arguments"
+ if (!defined $a) {
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is smaller
+ $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ }
}
- if (!defined $p)
- {
- # even if $a is defined, take $p, to signal error for both defined
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is bigger
- # -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
- }
+ if (!defined $p) {
+ # even if $a is defined, take $p, to signal error for both defined
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is bigger
+ # -2 > -3, and 3 > 2
+ $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ }
}
- # if still none defined, use globals (#2)
- $a = ${"$c\::accuracy"} unless defined $a;
- $p = ${"$c\::precision"} unless defined $p;
- # A == 0 is useless, so undef it to signal no rounding
- $a = undef if defined $a && $a == 0;
+ # if still none defined, use globals (#2)
+ $a = ${"$class\::accuracy"} unless defined $a;
+ $p = ${"$class\::precision"} unless defined $p;
- # no rounding today?
- return $self unless defined $a || defined $p; # early out
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
- # set A and set P is an fatal error
- return $self->bnan() if defined $a && defined $p;
+ # no rounding today?
+ return $self unless defined $a || defined $p; # early out
- $r = ${"$c\::round_mode"} unless defined $r;
- if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
- {
- require Carp; Carp::croak ("Unknown round mode '$r'");
- }
+ # set A and set P is an fatal error
+ return $self->bnan() if defined $a && defined $p;
- # now round, by calling either bround or bfround:
- if (defined $a)
- {
- $self->bround(int($a),$r) if !defined $self->{_a} || $self->{_a} >= $a;
+ $r = ${"$class\::round_mode"} unless defined $r;
+ if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
- else # both can't be undefined due to early out
- {
- $self->bfround(int($p),$r) if !defined $self->{_p} || $self->{_p} <= $p;
+
+ # now round, by calling either bround or bfround:
+ if (defined $a) {
+ $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a;
+ } else { # both can't be undefined due to early out
+ $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p;
}
- # bround() or bfround() already called bnorm() if nec.
- $self;
- }
+
+ # bround() or bfround() already called bnorm() if nec.
+ $self;
+}
sub bnorm
- {
+ {
# (numstr or BINT) return BINT
# Normalize number -- no-op here
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x;
}
-sub babs
+sub babs
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
@@ -1048,8 +1058,8 @@ sub bsgn {
return $self; # zero or NaN
}
-sub bneg
- {
+sub bneg
+ {
# (BINT or num_str) return BINT
# negate number or make a negated number from string
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
@@ -1061,7 +1071,7 @@ sub bneg
$x;
}
-sub bcmp
+sub bcmp
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT or num_str, BINT or num_str) return cond_code
@@ -1069,7 +1079,7 @@ sub bcmp
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y) = objectify(2,@_);
@@ -1089,33 +1099,33 @@ sub bcmp
return +1;
}
# check sign for speed first
- return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
- return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
+ return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
# have same sign, so compare absolute values. Don't make tests for zero
# here because it's actually slower than testing in Calc (especially w/ Pari
# et al)
# post-normalized compare for internal use (honors signs)
- if ($x->{sign} eq '+')
+ if ($x->{sign} eq '+')
{
# $x and $y both > 0
return $CALC->_acmp($x->{value},$y->{value});
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1)
}
-sub bacmp
+sub bacmp
{
- # Compares 2 values, ignoring their signs.
+ # Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y) = objectify(2,@_);
@@ -1132,17 +1142,17 @@ sub bacmp
return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
return -1;
}
- $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
+ $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
}
-sub badd
+sub badd
{
# add second arg (BINT or string) to first (BINT) (modifies first)
# return result as BINT
# set up parameters
my ($self,$x,$y,@r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y,@r) = objectify(2,@_);
@@ -1152,7 +1162,7 @@ sub badd
return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
((!$x->isa($self)) || (!$y->isa($self)));
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# inf and NaN handling
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
@@ -1171,20 +1181,20 @@ sub badd
return $x;
}
- my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
+ my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
- if ($sx eq $sy)
+ if ($sx eq $sy)
{
- $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
+ $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
}
- else
+ else
{
- my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
- if ($a > 0)
+ my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
+ if ($a > 0)
{
$x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sy;
- }
+ }
elsif ($a == 0)
{
# speedup, if equal, set result to 0
@@ -1199,7 +1209,7 @@ sub badd
$x->round(@r);
}
-sub bsub
+sub bsub
{
# (BINT or num_str, BINT or num_str) return BINT
# subtract second arg from first, modify first
@@ -1224,16 +1234,16 @@ sub bsub
# of $x, then flip the sign from $y, and if the sign of $x did change, too,
# then we caught the special case:
my $xsign = $x->{sign};
- $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
if ($xsign ne $x->{sign})
{
# special case of $x->bsub($x) results in 0
return $x->bzero(@r) if $xsign =~ /^[+-]$/;
return $x->bnan(); # NaN, -inf, +inf
}
- $x->badd($y,@r); # badd does not leave internal zeros
- $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
- $x; # already rounded by badd() or no round nec.
+ $x->badd($y,@r); # badd does not leave internal zeros
+ $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
+ $x; # already rounded by badd() or no round nec.
}
sub binc
@@ -1254,7 +1264,7 @@ sub binc
return $x->round($a,$p,$r);
}
# inf, nan handling etc
- $x->badd($self->bone(),$a,$p,$r); # badd does round
+ $x->badd($self->bone(),$a,$p,$r); # badd does round
}
sub bdec
@@ -1267,7 +1277,7 @@ sub bdec
{
# x already < 0
$x->{value} = $CALC->_inc($x->{value});
- }
+ }
else
{
return $x->badd($self->bone('-'),@r)
@@ -1276,7 +1286,7 @@ sub bdec
if ($CALC->_is_zero($x->{value}))
{
# == 0
- $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
+ $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
}
else
{
@@ -1392,7 +1402,7 @@ sub bnok
$z->binc();
my $r = $z->copy(); $z->binc();
my $d = $self->new(2);
- while ($z->bacmp($x) <= 0) # f <= x ?
+ while ($z->bacmp($x) <= 0) # f <= x ?
{
$r->bmul($z); $r->bdiv($d);
$z->binc(); $d->binc();
@@ -1452,16 +1462,16 @@ sub blcm
$x = $class->new($y);
}
my $self = ref($x);
- while (@_)
+ while (@_)
{
my $y = shift; $y = $self->new($y) if !ref ($y);
$x = __lcm($x,$y);
- }
+ }
$x;
}
-sub bgcd
- {
+sub bgcd
+ {
# (BINT or num_str, BINT or num_str) return BINT
# does not modify arguments, but returns new object
# GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)
@@ -1469,20 +1479,20 @@ sub bgcd
my $y = shift;
$y = $class->new($y) if !ref($y);
my $self = ref($y);
- my $x = $y->copy()->babs(); # keep arguments
- return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
+ my $x = $y->copy()->babs(); # keep arguments
+ return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
while (@_)
{
$y = shift; $y = $self->new($y) if !ref($y);
- return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
+ return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
$x->{value} = $CALC->_gcd($x->{value},$y->{value});
last if $CALC->_is_one($x->{value});
}
$x;
}
-sub bnot
+sub bnot
{
# (num_str or BINT) return BINT
# represent ~x as twos-complement number
@@ -1490,7 +1500,7 @@ sub bnot
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
return $x if $x->modify('bnot');
- $x->binc()->bneg(); # binc already does round
+ $x->binc()->bneg(); # binc already does round
}
##############################################################################
@@ -1502,7 +1512,7 @@ sub is_zero
# return true if arg (BINT or num_str) is zero (array '+', '0')
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
$CALC->_is_zero($x->{value});
}
@@ -1521,11 +1531,11 @@ sub is_inf
if (defined $sign)
{
- $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
- $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
+ $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
+ $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
return $x->{sign} =~ /^$sign$/ ? 1 : 0;
}
- $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
+ $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
}
sub is_one
@@ -1535,7 +1545,7 @@ sub is_one
$sign = '+' if !defined $sign || $sign ne '-';
- return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
+ return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
$CALC->_is_one($x->{value});
}
@@ -1544,7 +1554,7 @@ sub is_odd
# return true when arg (BINT or num_str) is odd, false for even
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$CALC->_is_odd($x->{value});
}
@@ -1553,7 +1563,7 @@ sub is_even
# return true when arg (BINT or num_str) is even, false for odd
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$CALC->_is_even($x->{value});
}
@@ -1562,7 +1572,7 @@ sub is_positive
# return true when arg (BINT or num_str) is positive (> 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 1 if $x->{sign} eq '+inf'; # +inf is positive
+ return 1 if $x->{sign} eq '+inf'; # +inf is positive
# 0+ is neither positive nor negative
($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
@@ -1573,7 +1583,7 @@ sub is_negative
# return true when arg (BINT or num_str) is negative (< 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
+ $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
}
sub is_int
@@ -1582,13 +1592,13 @@ sub is_int
# always true for BigInt, but different for BigFloats
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
+ $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
}
###############################################################################
-sub bmul
- {
+sub bmul
+ {
# multiply the first number by the second number
# (BINT or num_str, BINT or num_str) return BINT
@@ -1611,26 +1621,26 @@ sub bmul
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
return $upgrade->bmul($x,$upgrade->new($y),@r)
if defined $upgrade && !$y->isa($self);
- $r[3] = $y; # no push here
+ $r[3] = $y; # no push here
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
+ $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
$x->round(@r);
}
sub bmuladd
- {
+ {
# multiply two numbers and then add the third to the result
# (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
@@ -1640,8 +1650,8 @@ sub bmuladd
return $x if $x->modify('bmuladd');
return $x->bnan() if ($x->{sign} eq $nan) ||
- ($y->{sign} eq $nan) ||
- ($z->{sign} eq $nan);
+ ($y->{sign} eq $nan) ||
+ ($z->{sign} eq $nan);
# inf handling of x and y
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
@@ -1650,8 +1660,8 @@ sub bmuladd
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
# inf handling x*y and z
@@ -1665,27 +1675,27 @@ sub bmuladd
if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self));
# TODO: what if $y and $z have A or P set?
- $r[3] = $z; # no push here
+ $r[3] = $z; # no push here
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
+ $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
- my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
+ my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
- if ($sx eq $sz)
+ if ($sx eq $sz)
{
- $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
+ $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
}
- else
+ else
{
- my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
- if ($a > 0)
+ my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
+ if ($a > 0)
{
$x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sz;
- }
+ }
elsif ($a == 0)
{
# speedup, if equal, set result to 0
@@ -1812,11 +1822,11 @@ sub bdiv
return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
if defined $upgrade;
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# Inialize remainder.
- my $rem = $self->bzero();
+ my $rem = $self->bzero();
# Are both operands the same object, i.e., like $x -> bdiv($x)?
# If so, flipping the sign of $y also flips the sign of $x.
@@ -1874,7 +1884,7 @@ sub bdiv
###############################################################################
# modulus functions
-sub bmod
+sub bmod
{
# This is the remainder after floored division, where the quotient is
@@ -1891,7 +1901,7 @@ sub bmod
}
return $x if $x->modify('bmod');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# At least one argument is NaN.
@@ -1930,7 +1940,7 @@ sub bmod
}
else
{
- $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
+ $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
if ($x->{sign} ne $y->{sign});
$x->{sign} = $y->{sign};
}
@@ -2127,14 +2137,14 @@ sub bfac
# compute factorial number from $x, modify $x in place
my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
- return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
- return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
+ return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
+ return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
$x->{value} = $CALC->_fac($x->{value});
$x->round(@r);
}
-sub bpow
+sub bpow
{
# (BINT or num_str, BINT or num_str) return BINT
# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
@@ -2204,15 +2214,15 @@ sub bpow
return $upgrade->bpow($upgrade->new($x),$y,@r)
if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
my $new_sign = '+';
- $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+ $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
- # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
- return $x->binf()
+ # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
+ return $x->binf()
if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
# 1 ** -y => 1 / (1 ** |y|)
# so do test for negative $y after above's clause
@@ -2224,7 +2234,7 @@ sub bpow
$x->round(@r);
}
-sub blsft
+sub blsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
@@ -2247,7 +2257,7 @@ sub blsft
$x->round(@r);
}
-sub brsft
+sub brsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
@@ -2263,52 +2273,52 @@ sub brsft
return $x if $x->modify('brsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x->round(@r) if $y->is_zero();
- return $x->bzero(@r) if $x->is_zero(); # 0 => 0
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
# this only works for negative numbers when shifting in base 2
if (($x->{sign} eq '-') && ($n == 2))
{
- return $x->round(@r) if $x->is_one('-'); # -1 => -1
+ return $x->round(@r) if $x->is_one('-'); # -1 => -1
if (!$y->is_one())
{
# although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
# but perhaps there is a better emulation for two's complement shift...
# if $y != 1, we must simulate it by doing:
# convert to bin, flip all bits, shift, and be done
- $x->binc(); # -3 => -2
+ $x->binc(); # -3 => -2
my $bin = $x->as_bin();
- $bin =~ s/^-0b//; # strip '-0b' prefix
- $bin =~ tr/10/01/; # flip bits
+ $bin =~ s/^-0b//; # strip '-0b' prefix
+ $bin =~ tr/10/01/; # flip bits
# now shift
if ($y >= CORE::length($bin))
{
- $bin = '0'; # shifting to far right creates -1
- # 0, because later increment makes
- # that 1, attached '-' makes it '-1'
- # because -1 >> x == -1 !
- }
+ $bin = '0'; # shifting to far right creates -1
+ # 0, because later increment makes
+ # that 1, attached '-' makes it '-1'
+ # because -1 >> x == -1 !
+ }
else
- {
- $bin =~ s/.{$y}$//; # cut off at the right side
- $bin = '1' . $bin; # extend left side by one dummy '1'
- $bin =~ tr/10/01/; # flip bits back
- }
- my $res = $self->new('0b'.$bin); # add prefix and convert back
- $res->binc(); # remember to increment
- $x->{value} = $res->{value}; # take over value
- return $x->round(@r); # we are done now, magic, isn't?
+ {
+ $bin =~ s/.{$y}$//; # cut off at the right side
+ $bin = '1' . $bin; # extend left side by one dummy '1'
+ $bin =~ tr/10/01/; # flip bits back
+ }
+ my $res = $self->new('0b'.$bin); # add prefix and convert back
+ $res->binc(); # remember to increment
+ $x->{value} = $res->{value}; # take over value
+ return $x->round(@r); # we are done now, magic, isn't?
}
# x < 0, n == 2, y == 1
- $x->bdec(); # n == 2, but $y == 1: this fixes it
+ $x->bdec(); # n == 2, but $y == 1: this fixes it
}
$x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
$x->round(@r);
}
-sub band
+sub band
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x & y
@@ -2323,7 +2333,7 @@ sub band
return $x if $x->modify('band');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2346,7 +2356,7 @@ sub band
__emu_band($self,$x,$y,$sx,$sy,@r);
}
-sub bior
+sub bior
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x | y
@@ -2360,7 +2370,7 @@ sub bior
}
return $x if $x->modify('bior');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2387,7 +2397,7 @@ sub bior
__emu_bior($self,$x,$y,$sx,$sy,@r);
}
-sub bxor
+sub bxor
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x ^ y
@@ -2401,7 +2411,7 @@ sub bxor
}
return $x if $x->modify('bxor');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2430,7 +2440,7 @@ sub length
{
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- my $e = $CALC->_len($x->{value});
+ my $e = $CALC->_len($x->{value});
wantarray ? ($e,0) : $e;
}
@@ -2449,9 +2459,9 @@ sub _trailing_zeros
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
- $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
+ $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
}
sub bsqrt
@@ -2461,8 +2471,8 @@ sub bsqrt
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
- return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
+ return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
+ return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
return $upgrade->bsqrt($x,@r) if defined $upgrade;
@@ -2553,13 +2563,13 @@ sub bfround
my ($scale,$mode) = $x->_scale_p(@_);
- return $x if !defined $scale || $x->modify('bfround'); # no-op
+ return $x if !defined $scale || $x->modify('bfround'); # no-op
# no-op for BigInts if $n <= 0
$x->bround( $x->length()-$scale, $mode) if $scale > 0;
- delete $x->{_a}; # delete to save memory
- $x->{_p} = $scale; # store new _p
+ delete $x->{_a}; # delete to save memory
+ $x->{_p} = $scale; # store new _p
$x;
}
@@ -2568,7 +2578,7 @@ sub _scan_for_nonzero
# internal, used by bround() to scan for non-zeros after a '5'
my ($x,$pad,$xs,$len) = @_;
- return 0 if $len == 1; # "5" is trailed by invisible zeros
+ return 0 if $len == 1; # "5" is trailed by invisible zeros
my $follow = $pad - 1;
return 0 if $follow > $len || $follow < 1;
@@ -2594,14 +2604,14 @@ sub bround
my $x = shift; $x = $class->new($x) unless ref $x;
my ($scale,$mode) = $x->_scale_a(@_);
- return $x if !defined $scale || $x->modify('bround'); # no-op
+ return $x if !defined $scale || $x->modify('bround'); # no-op
if ($x->is_zero() || $scale == 0)
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
return $x;
}
- return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
# we have fewer digits than we want to scale to
my $len = $x->length();
@@ -2614,7 +2624,7 @@ sub bround
if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
- return $x;
+ return $x;
}
# count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
@@ -2635,50 +2645,50 @@ sub bround
# in case of 01234 we round down, for 6789 up, and only in case 5 we look
# closer at the remaining digits of the original $x, remember decision
- my $round_up = 1; # default round up
+ my $round_up = 1; # default round up
$round_up -- if
- ($mode eq 'trunc') || # trunc by round down
- ($digit_after =~ /[01234]/) || # round down anyway,
- # 6789 => round up
- ($digit_after eq '5') && # not 5000...0000
- ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
+ ($mode eq 'trunc') || # trunc by round down
+ ($digit_after =~ /[01234]/) || # round down anyway,
+ # 6789 => round up
+ ($digit_after eq '5') && # not 5000...0000
+ ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
(
($mode eq 'even') && ($digit_round =~ /[24680]/) ||
($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
($mode eq '+inf') && ($x->{sign} eq '-') ||
($mode eq '-inf') && ($x->{sign} eq '+') ||
- ($mode eq 'zero') # round down if zero, sign adjusted below
+ ($mode eq 'zero') # round down if zero, sign adjusted below
);
- my $put_back = 0; # not yet modified
-
+ my $put_back = 0; # not yet modified
+
if (($pad > 0) && ($pad <= $len))
{
- substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
- $put_back = 1; # need to put back
+ substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
+ $put_back = 1; # need to put back
}
elsif ($pad > $len)
{
- $x->bzero(); # round to '0'
+ $x->bzero(); # round to '0'
}
- if ($round_up) # what gave test above?
+ if ($round_up) # what gave test above?
{
- $put_back = 1; # need to put back
- $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
+ $put_back = 1; # need to put back
+ $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
# we modify directly the string variant instead of creating a number and
# adding it, since that is faster (we already have the string)
- my $c = 0; $pad ++; # for $pad == $len case
+ my $c = 0; $pad ++; # for $pad == $len case
while ($pad <= $len)
{
$c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
substr($xs,-$pad,1) = $c; $pad++;
- last if $c != 0; # no overflow => early out
+ last if $c != 0; # no overflow => early out
}
$xs = '1'.$xs if $c == 0;
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
+ $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0)
@@ -2725,7 +2735,7 @@ sub as_hex
# return as hex string, with prefixed 0x
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
@@ -2737,7 +2747,7 @@ sub as_bin
# return as binary string, with prefixed 0b
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
return $s . $CALC->_as_bin($x->{value});
@@ -2748,10 +2758,10 @@ sub as_oct
# return as octal string, with prefixed 0
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
- return $s . $CALC->_as_oct($x->{value});
+ my $oct = $CALC->_as_oct($x->{value});
+ return $x->{sign} eq '-' ? "-$oct" : $oct;
}
##############################################################################
@@ -2903,33 +2913,33 @@ sub _register_callback
my ($class,$callback) = @_;
if (ref($callback) ne 'CODE')
- {
+ {
require Carp;
Carp::croak ("$callback is not a coderef");
}
$CALLBACKS{$class} = $callback;
}
-sub import
+sub import
{
my $self = shift;
- $IMPORT++; # remember we did import()
+ $IMPORT++; # remember we did import()
my @a; my $l = scalar @_;
- my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
+ my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
for ( my $i = 0; $i < $l ; $i++ )
{
if ($_[$i] eq ':constant')
{
# this causes overlord er load to step in
- overload::constant
- integer => sub { $self->new(shift) },
- binary => sub { $self->new(shift) };
+ overload::constant
+ integer => sub { $self->new(shift) },
+ binary => sub { $self->new(shift) };
}
elsif ($_[$i] eq 'upgrade')
{
# this causes upgrading
- $upgrade = $_[$i+1]; # or undef to disable
+ $upgrade = $_[$i+1]; # or undef to disable
$i++;
}
elsif ($_[$i] =~ /^(lib|try|only)\z/)
@@ -2951,19 +2961,19 @@ sub import
{
require Exporter;
- $self->SUPER::import(@a); # need it for subclasses
- $self->export_to_level(1,$self,@a); # need it for MBF
+ $self->SUPER::import(@a); # need it for subclasses
+ $self->export_to_level(1,$self,@a); # need it for MBF
}
# try to load core math lib
my @c = split /\s*,\s*/,$CALC;
foreach (@c)
{
- $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+ $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
}
- push @c, \'Calc' # if all fail, try these
- if $warn_or_die < 2; # but not for "only"
- $CALC = ''; # signal error
+ push @c, \'Calc' # if all fail, try these
+ if $warn_or_die < 2; # but not for "only"
+ $CALC = ''; # signal error
foreach my $l (@c)
{
# fallback libraries are "marked" as \'string', extract string if nec.
@@ -2991,55 +3001,55 @@ sub import
my $ok = 1;
# loaded it ok, see if the api_version() is high enough
if ($lib->can('api_version') && $lib->api_version() >= 1.0)
- {
- $ok = 0;
- # api_version matches, check if it really provides anything we need
+ {
+ $ok = 0;
+ # api_version matches, check if it really provides anything we need
for my $method (qw/
- one two ten
- str num
- add mul div sub dec inc
- acmp len digit is_one is_zero is_even is_odd
- is_two is_ten
- zeros new copy check
- from_hex from_oct from_bin as_hex as_bin as_oct
- rsft lsft xor and or
- mod sqrt root fac pow modinv modpow log_int gcd
- /)
+ one two ten
+ str num
+ add mul div sub dec inc
+ acmp len digit is_one is_zero is_even is_odd
+ is_two is_ten
+ zeros new copy check
+ from_hex from_oct from_bin as_hex as_bin as_oct
+ rsft lsft xor and or
+ mod sqrt root fac pow modinv modpow log_int gcd
+ /)
{
- if (!$lib->can("_$method"))
- {
- if (($WARN{$lib}||0) < 2)
- {
- require Carp;
- Carp::carp ("$lib is missing method '_$method'");
- $WARN{$lib} = 1; # still warn about the lib
- }
- $ok++; last;
- }
+ if (!$lib->can("_$method"))
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ require Carp;
+ Carp::carp ("$lib is missing method '_$method'");
+ $WARN{$lib} = 1; # still warn about the lib
+ }
+ $ok++; last;
+ }
}
- }
+ }
if ($ok == 0)
- {
- $CALC = $lib;
- if ($warn_or_die > 0 && ref($l))
- {
- require Carp;
- my $msg =
+ {
+ $CALC = $lib;
+ if ($warn_or_die > 0 && ref($l))
+ {
+ require Carp;
+ my $msg =
"Math::BigInt: couldn't load specified math lib(s), fallback to $lib";
Carp::carp ($msg) if $warn_or_die == 1;
Carp::croak ($msg) if $warn_or_die == 2;
- }
- last; # found a usable one, break
- }
+ }
+ last; # found a usable one, break
+ }
else
- {
- if (($WARN{$lib}||0) < 2)
- {
- my $ver = eval "\$$lib\::VERSION" || 'unknown';
- require Carp;
- Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
- $WARN{$lib} = 2; # never warn again
- }
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ my $ver = eval "\$$lib\::VERSION" || 'unknown';
+ require Carp;
+ Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
+ $WARN{$lib} = 2; # never warn again
+ }
}
}
}
@@ -3076,10 +3086,18 @@ sub import
# import done
}
+# Create a Math::BigInt from a hexadecimal string.
+
sub from_hex {
- # Create a bigint from a hexadecimal string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my ($self, $str) = @_;
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -3100,21 +3118,17 @@ sub from_hex {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_hex('0x' . $chrs);
+ $self->{value} = $CALC->_from_hex('0x' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# CORE::hex() parses as much as it can, and ignores any trailing garbage.
@@ -3123,10 +3137,18 @@ sub from_hex {
return $self->bnan();
}
+# Create a Math::BigInt from an octal string.
+
sub from_oct {
- # Create a bigint from an octal string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ my $str = shift;
- my ($self, $str) = @_;
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -3146,21 +3168,17 @@ sub from_oct {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_oct('0' . $chrs);
+ $self->{value} = $CALC->_from_oct('0' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# CORE::oct() parses as much as it can, and ignores any trailing garbage.
@@ -3169,10 +3187,18 @@ sub from_oct {
return $self->bnan();
}
+# Create a Math::BigInt from a binary string.
+
sub from_bin {
- # Create a bigint from a binary string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
- my ($self, $str) = @_;
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -3193,21 +3219,17 @@ sub from_bin {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_bin('0b' . $chrs);
+ $self->{value} = $CALC->_from_bin('0b' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# For consistency with from_hex() and from_oct(), we return NaN when the
@@ -3216,6 +3238,80 @@ sub from_bin {
return $self->bnan();
}
+sub _split_dec_string {
+ my $str = shift;
+
+ if ($str =~ s/
+ ^
+
+ # leading whitespace
+ ( \s* )
+
+ # optional sign
+ ( [+-]? )
+
+ # significand
+ (
+ \d+ (?: _ \d+ )*
+ (?:
+ \.
+ (?: \d+ (?: _ \d+ )* )?
+ )?
+ |
+ \.
+ \d+ (?: _ \d+ )*
+ )
+
+ # optional exponent
+ (?:
+ [Ee]
+ ( [+-]? )
+ ( \d+ (?: _ \d+ )* )
+ )?
+
+ # trailing stuff
+ ( \D .*? )?
+
+ \z
+ //x)
+ {
+ my $leading = $1;
+ my $significand_sgn = $2 || '+';
+ my $significand_abs = $3;
+ my $exponent_sgn = $4 || '+';
+ my $exponent_abs = $5 || '0';
+ my $trailing = $6;
+
+ # Remove underscores and leading zeros.
+
+ $significand_abs =~ tr/_//d;
+ $exponent_abs =~ tr/_//d;
+
+ $significand_abs =~ s/^0+(.)/$1/;
+ $exponent_abs =~ s/^0+(.)/$1/;
+
+ # If the significand contains a dot, remove it and adjust the exponent
+ # accordingly. E.g., "1234.56789e+3" -> "123456789e-2"
+
+ my $idx = index $significand_abs, '.';
+ if ($idx > -1) {
+ $significand_abs =~ s/0+\z//;
+ substr($significand_abs, $idx, 1) = '';
+ my $exponent = $exponent_sgn . $exponent_abs;
+ $exponent .= $idx - CORE::length($significand_abs);
+ $exponent_abs = abs $exponent;
+ $exponent_sgn = $exponent < 0 ? '-' : '+';
+ }
+
+ return($leading,
+ $significand_sgn, $significand_abs,
+ $exponent_sgn, $exponent_abs,
+ $trailing);
+ }
+
+ return undef;
+}
+
sub _split
{
# input: num_str; output: undef for invalid or
@@ -3246,33 +3342,33 @@ sub _split
# strip underscores between digits
$x =~ s/([0-9])_([0-9])/$1$2/g;
- $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
+ $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
- # some possible inputs:
- # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
- # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
+ # some possible inputs:
+ # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
+ # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
my ($m,$e,$last) = split /[Ee]/,$x;
- return if defined $last; # last defined => 1e2E3 or others
+ return if defined $last; # last defined => 1e2E3 or others
$e = '0' if !defined $e || $e eq "";
# sign,value for exponent,mantint,mantfrac
my ($es,$ev,$mis,$miv,$mfv);
# valid exponent?
- if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
+ if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
{
$es = $1; $ev = $2;
# valid mantissa?
return if $m eq '.' || $m eq '';
my ($mi,$mf,$lastf) = split /\./,$m;
- return if defined $lastf; # lastf defined => 1.2.3 or others
+ return if defined $lastf; # lastf defined => 1.2.3 or others
$mi = '0' if !defined $mi;
$mi .= '0' if $mi =~ /^[\-\+]?$/;
$mf = '0' if !defined $mf || $mf eq '';
- if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
+ if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
{
$mis = $1||'+'; $miv = $2;
- return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
+ return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
$mfv = $1;
# handle the 0e999 case here
$ev = 0 if $miv eq '0' && $mfv eq '';
@@ -3285,8 +3381,8 @@ sub _split
##############################################################################
# internal calculation routines (others are in Math::BigInt::Calc etc)
-sub __lcm
- {
+sub __lcm
+ {
# (BINT or num_str, BINT or num_str) return BINT
# does modify first argument
# LCM
@@ -3327,7 +3423,7 @@ sub bcos
return $x if $x->modify('bcos');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->bcos(@r) if defined $upgrade;
@@ -3348,7 +3444,7 @@ sub bsin
return $x if $x->modify('bsin');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->bsin(@r) if defined $upgrade;
@@ -3362,7 +3458,7 @@ sub bsin
}
sub batan2
- {
+ {
# calculate arcus tangens of ($y/$x)
# set up parameters
@@ -3440,7 +3536,7 @@ sub batan
return $x if $x->modify('batan');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->batan(@r) if defined $upgrade;
@@ -3489,108 +3585,108 @@ Math::BigInt - Arbitrary size integer/float math package
my @values = (64,74,18);
my $n = 1; my $sign = '-';
- # Number creation
- my $x = Math::BigInt->new($str); # defaults to 0
- my $y = $x->copy(); # make a true copy
- my $nan = Math::BigInt->bnan(); # create a NotANumber
- my $zero = Math::BigInt->bzero(); # create a +0
- my $inf = Math::BigInt->binf(); # create a +inf
- my $inf = Math::BigInt->binf('-'); # create a -inf
- my $one = Math::BigInt->bone(); # create a +1
- my $mone = Math::BigInt->bone('-'); # create a -1
-
- my $pi = Math::BigInt->bpi(); # returns '3'
- # see Math::BigFloat::bpi()
-
- $h = Math::BigInt->new('0x123'); # from hexadecimal
- $b = Math::BigInt->new('0b101'); # from binary
- $o = Math::BigInt->from_oct('0101'); # from octal
- $h = Math::BigInt->from_hex('cafe'); # from hexadecimal
- $b = Math::BigInt->from_bin('0101'); # from binary
+ # Number creation
+ my $x = Math::BigInt->new($str); # defaults to 0
+ my $y = $x->copy(); # make a true copy
+ my $nan = Math::BigInt->bnan(); # create a NotANumber
+ my $zero = Math::BigInt->bzero(); # create a +0
+ my $inf = Math::BigInt->binf(); # create a +inf
+ my $inf = Math::BigInt->binf('-'); # create a -inf
+ my $one = Math::BigInt->bone(); # create a +1
+ my $mone = Math::BigInt->bone('-'); # create a -1
+
+ my $pi = Math::BigInt->bpi(); # returns '3'
+ # see Math::BigFloat::bpi()
+
+ $h = Math::BigInt->new('0x123'); # from hexadecimal
+ $b = Math::BigInt->new('0b101'); # from binary
+ $o = Math::BigInt->from_oct('0101'); # from octal
+ $h = Math::BigInt->from_hex('cafe'); # from hexadecimal
+ $b = Math::BigInt->from_bin('0101'); # from binary
# Testing (don't modify their arguments)
# (return true if the condition is met, otherwise false)
- $x->is_zero(); # if $x is +0
- $x->is_nan(); # if $x is NaN
- $x->is_one(); # if $x is +1
- $x->is_one('-'); # if $x is -1
- $x->is_odd(); # if $x is odd
- $x->is_even(); # if $x is even
- $x->is_pos(); # if $x > 0
- $x->is_neg(); # if $x < 0
- $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
- $x->is_int(); # if $x is an integer (not a float)
+ $x->is_zero(); # if $x is +0
+ $x->is_nan(); # if $x is NaN
+ $x->is_one(); # if $x is +1
+ $x->is_one('-'); # if $x is -1
+ $x->is_odd(); # if $x is odd
+ $x->is_even(); # if $x is even
+ $x->is_pos(); # if $x > 0
+ $x->is_neg(); # if $x < 0
+ $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
+ $x->is_int(); # if $x is an integer (not a float)
# comparing and digit/sign extraction
- $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
- $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
- $x->sign(); # return the sign, either +,- or NaN
- $x->digit($n); # return the nth digit, counting from right
- $x->digit(-$n); # return the nth digit, counting from left
+ $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
+ $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
+ $x->sign(); # return the sign, either +,- or NaN
+ $x->digit($n); # return the nth digit, counting from right
+ $x->digit(-$n); # return the nth digit, counting from left
# The following all modify their first argument. If you want to pre-
# serve $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for
# why this is necessary when mixing $a = $b assignments with non-over-
# loaded math.
- $x->bzero(); # set $x to 0
- $x->bnan(); # set $x to NaN
- $x->bone(); # set $x to +1
- $x->bone('-'); # set $x to -1
- $x->binf(); # set $x to inf
- $x->binf('-'); # set $x to -inf
-
- $x->bneg(); # negation
- $x->babs(); # absolute value
- $x->bsgn(); # sign function (-1, 0, 1, or NaN)
- $x->bnorm(); # normalize (no-op in BigInt)
- $x->bnot(); # two's complement (bit wise not)
- $x->binc(); # increment $x by 1
- $x->bdec(); # decrement $x by 1
-
- $x->badd($y); # addition (add $y to $x)
- $x->bsub($y); # subtraction (subtract $y from $x)
- $x->bmul($y); # multiplication (multiply $x by $y)
- $x->bdiv($y); # divide, set $x to quotient
- # return (quo,rem) or quo if scalar
-
- $x->bmuladd($y,$z); # $x = $x * $y + $z
-
- $x->bmod($y); # modulus (x % y)
+ $x->bzero(); # set $x to 0
+ $x->bnan(); # set $x to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
+ $x->binf(); # set $x to inf
+ $x->binf('-'); # set $x to -inf
+
+ $x->bneg(); # negation
+ $x->babs(); # absolute value
+ $x->bsgn(); # sign function (-1, 0, 1, or NaN)
+ $x->bnorm(); # normalize (no-op in BigInt)
+ $x->bnot(); # two's complement (bit wise not)
+ $x->binc(); # increment $x by 1
+ $x->bdec(); # decrement $x by 1
+
+ $x->badd($y); # addition (add $y to $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bdiv($y); # divide, set $x to quotient
+ # return (quo,rem) or quo if scalar
+
+ $x->bmuladd($y,$z); # $x = $x * $y + $z
+
+ $x->bmod($y); # modulus (x % y)
$x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod)
$x->bmodinv($mod); # modular multiplicative inverse
- $x->bpow($y); # power of arguments (x ** y)
- $x->blsft($y); # left shift in base 2
- $x->brsft($y); # right shift in base 2
- # returns (quo,rem) or quo if in sca-
- # lar context
- $x->blsft($y,$n); # left shift by $y places in base $n
- $x->brsft($y,$n); # right shift by $y places in base $n
- # returns (quo,rem) or quo if in sca-
- # lar context
-
- $x->band($y); # bitwise and
- $x->bior($y); # bitwise inclusive or
- $x->bxor($y); # bitwise exclusive or
- $x->bnot(); # bitwise not (two's complement)
-
- $x->bsqrt(); # calculate square-root
- $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
- $x->bfac(); # factorial of $x (1*2*3*4*..$x)
-
- $x->bnok($y); # x over y (binomial coefficient n over k)
-
- $x->blog(); # logarithm of $x to base e (Euler's number)
- $x->blog($base); # logarithm of $x to base $base (f.i. 2)
- $x->bexp(); # calculate e ** $x where e is Euler's number
+ $x->bpow($y); # power of arguments (x ** y)
+ $x->blsft($y); # left shift in base 2
+ $x->brsft($y); # right shift in base 2
+ # returns (quo,rem) or quo if in sca-
+ # lar context
+ $x->blsft($y,$n); # left shift by $y places in base $n
+ $x->brsft($y,$n); # right shift by $y places in base $n
+ # returns (quo,rem) or quo if in sca-
+ # lar context
+
+ $x->band($y); # bitwise and
+ $x->bior($y); # bitwise inclusive or
+ $x->bxor($y); # bitwise exclusive or
+ $x->bnot(); # bitwise not (two's complement)
+
+ $x->bsqrt(); # calculate square-root
+ $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+
+ $x->bnok($y); # x over y (binomial coefficient n over k)
+
+ $x->blog(); # logarithm of $x to base e (Euler's number)
+ $x->blog($base); # logarithm of $x to base $base (f.i. 2)
+ $x->bexp(); # calculate e ** $x where e is Euler's number
$x->round($A,$P,$mode); # round to accuracy or precision using
- # mode $mode
- $x->bround($n); # accuracy: preserve $n digits
- $x->bfround($n); # $n > 0: round $nth digits,
- # $n < 0: round to the $nth digit after the
- # dot, no-op for BigInts
+ # mode $mode
+ $x->bround($n); # accuracy: preserve $n digits
+ $x->bfround($n); # $n > 0: round $nth digits,
+ # $n < 0: round to the $nth digit after the
+ # dot, no-op for BigInts
# The following do not modify their arguments in BigInt (are no-ops),
# but do so in BigFloat:
@@ -3606,38 +3702,38 @@ Math::BigInt - Arbitrary size integer/float math package
# lowest common multiple (no OO style)
my $lcm = Math::BigInt::blcm(@values);
- $x->length(); # return number of digits in number
+ $x->length(); # return number of digits in number
($xl,$f) = $x->length(); # length of number and length of fraction
- # part, latter is always 0 digits long
- # for BigInts
+ # part, latter is always 0 digits long
+ # for BigInts
- $x->exponent(); # return exponent as BigInt
- $x->mantissa(); # return (signed) mantissa as BigInt
- $x->parts(); # return (mantissa,exponent) as BigInt
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
- $x->as_int(); # return as BigInt (in BigInt: same as copy())
- $x->numify(); # return as scalar (might overflow!)
+ $x->exponent(); # return exponent as BigInt
+ $x->mantissa(); # return (signed) mantissa as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->as_int(); # return as BigInt (in BigInt: same as copy())
+ $x->numify(); # return as scalar (might overflow!)
# conversion to string (do not modify their argument)
- $x->bstr(); # normalized string (e.g. '3')
- $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
- $x->as_hex(); # as signed hexadecimal string with prefixed 0x
- $x->as_bin(); # as signed binary string with prefixed 0b
- $x->as_oct(); # as signed octal string with prefixed 0
+ $x->bstr(); # normalized string (e.g. '3')
+ $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+ $x->as_bin(); # as signed binary string with prefixed 0b
+ $x->as_oct(); # as signed octal string with prefixed 0
# precision and accuracy (see section about rounding for more)
- $x->precision(); # return P of $x (or global, if P of $x undef)
- $x->precision($n); # set P of $x to $n
- $x->accuracy(); # return A of $x (or global, if A of $x undef)
- $x->accuracy($n); # set A $x to $n
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set A $x to $n
# Global methods
Math::BigInt->precision(); # get/set global P for all BigInt objects
Math::BigInt->accuracy(); # get/set global A for all BigInt objects
Math::BigInt->round_mode(); # get/set global round mode, one of
- # 'even', 'odd', '+inf', '-inf', 'zero',
- # 'trunc' or 'common'
+ # 'even', 'odd', '+inf', '-inf', 'zero',
+ # 'trunc' or 'common'
Math::BigInt->config(); # return hash containing configuration
=head1 DESCRIPTION
@@ -3659,8 +3755,8 @@ Scalars holding numbers may also be passed, but note that non-integer numbers
may already have lost precision due to the conversion to float. Quote
your input if you want BigInt to see all the digits:
- $x = Math::BigInt->new(12345678890123456789); # bad
- $x = Math::BigInt->new('12345678901234567890'); # good
+ $x = Math::BigInt->new(12345678890123456789); # bad
+ $x = Math::BigInt->new('12345678901234567890'); # good
You can include one underscore between any two digits.
@@ -3671,21 +3767,21 @@ Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b")
are accepted, too. Please note that octal numbers are not recognized
by new(), so the following will print "123":
- perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
+ perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
To convert an octal number, use from_oct();
- perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
+ perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
results in 'NaN'. This might change in the future, so use always the following
explicit forms to get a zero or NaN:
- $zero = Math::BigInt->bzero();
- $nan = Math::BigInt->bnan();
+ $zero = Math::BigInt->bzero();
+ $nan = Math::BigInt->bnan();
-C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
-are always stored in normalized form. If passed a string, creates a BigInt
+C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
+are always stored in normalized form. If passed a string, creates a BigInt
object from the input.
=head2 Output
@@ -3717,50 +3813,50 @@ Returns a hash containing the configuration, e.g. the version number, lib
loaded etc. The following hash keys are currently filled in with the
appropriate information.
- key Description
- Example
+ key Description
+ Example
============================================================
- lib Name of the low-level math library
- Math::BigInt::Calc
+ lib Name of the low-level math library
+ Math::BigInt::Calc
lib_version Version of low-level math library (see 'lib')
- 0.30
- class The class name of config() you just called
- Math::BigInt
- upgrade To which class math operations might be
- upgraded Math::BigFloat
+ 0.30
+ class The class name of config() you just called
+ Math::BigInt
+ upgrade To which class math operations might be
+ upgraded Math::BigFloat
downgrade To which class math operations might be
- downgraded undef
+ downgraded undef
precision Global precision
- undef
+ undef
accuracy Global accuracy
- undef
+ undef
round_mode Global round mode
- even
- version version number of the class you used
- 1.61
+ even
+ version version number of the class you used
+ 1.61
div_scale Fallback accuracy for div
- 40
+ 40
trap_nan If true, traps creation of NaN via croak()
- 1
+ 1
trap_inf If true, traps creation of +inf/-inf via croak()
- 1
+ 1
The following values can be set by passing C<config()> a reference to a hash:
- trap_inf trap_nan
+ trap_inf trap_nan
upgrade downgrade precision accuracy round_mode div_scale
Example:
- $new_cfg = Math::BigInt->config(
- { trap_inf => 1, precision => 5 }
- );
+ $new_cfg = Math::BigInt->config(
+ { trap_inf => 1, precision => 5 }
+ );
=item accuracy()
- $x->accuracy(5); # local for $x
- CLASS->accuracy(5); # global for all members of CLASS
- # Note: This also applies to new()!
+ $x->accuracy(5); # local for $x
+ CLASS->accuracy(5); # global for all members of CLASS
+ # Note: This also applies to new()!
$A = $x->accuracy(); # read out accuracy that affects $x
$A = CLASS->accuracy(); # read out global accuracy
@@ -3778,8 +3874,8 @@ to the math operation as additional parameter:
my $x = Math::BigInt->new(30000);
my $y = Math::BigInt->new(7);
- print scalar $x->copy()->bdiv($y, 2); # print 4300
- print scalar $x->copy()->bdiv($y)->bround(2); # print 4300
+ print scalar $x->copy()->bdiv($y, 2); # print 4300
+ print scalar $x->copy()->bdiv($y)->bround(2); # print 4300
Please see the section about L</ACCURACY and PRECISION> for further details.
@@ -3792,17 +3888,17 @@ Returns the current accuracy. For C<< $x->accuracy() >> it will return either
the local accuracy, or if not defined, the global. This means the return value
represents the accuracy that will be in effect for $x:
- $y = Math::BigInt->new(1234567); # unrounded
+ $y = Math::BigInt->new(1234567); # unrounded
print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
- $x = Math::BigInt->new(123456); # $x will be automatic-
- # ally rounded!
- print "$x $y\n"; # '123500 1234567'
- print $x->accuracy(),"\n"; # will be 4
- print $y->accuracy(),"\n"; # also 4, since
- # global is 4
+ $x = Math::BigInt->new(123456); # $x will be automatic-
+ # ally rounded!
+ print "$x $y\n"; # '123500 1234567'
+ print $x->accuracy(),"\n"; # will be 4
+ print $y->accuracy(),"\n"; # also 4, since
+ # global is 4
print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
- print $x->accuracy(),"\n"; # still 4
- print $y->accuracy(),"\n"; # 5, since global is 5
+ print $x->accuracy(),"\n"; # still 4
+ print $y->accuracy(),"\n"; # 5, since global is 5
Note: Works also for subclasses like Math::BigFloat. Each class has it's own
globals separated from Math::BigInt, but it is possible to subclass
@@ -3846,10 +3942,10 @@ Returns the current precision. For C<< $x->precision() >> it will return either
the local precision of $x, or if not defined, the global. This means the return
value represents the prevision that will be in effect for $x:
- $y = Math::BigInt->new(1234567); # unrounded
+ $y = Math::BigInt->new(1234567); # unrounded
print Math::BigInt->precision(4),"\n"; # set 4, print 4
$x = Math::BigInt->new(123456); # will be automatically rounded
- print $x; # print "120000"!
+ print $x; # print "120000"!
Note: Works also for subclasses like L<Math::BigFloat>. Each class has its
own globals separated from Math::BigInt, but it is possible to subclass
@@ -3868,9 +3964,9 @@ result:
$x = Math::BigInt->new(10);
- $x->brsft(1); # same as $x >> 1: 5
+ $x->brsft(1); # same as $x >> 1: 5
$x = Math::BigInt->new(1234);
- $x->brsft(2,10); # result 12
+ $x->brsft(2,10); # result 12
There is one exception, and that is base 2 with negative $x:
@@ -3953,17 +4049,17 @@ Creates a new BigInt object representing one. The optional argument is
either '-' or '+', indicating whether you want one or minus one.
If used on an object, it will set it to one:
- $x->bone(); # +1
- $x->bone('-'); # -1
+ $x->bone(); # +1
+ $x->bone('-'); # -1
=item is_one()/is_zero()/is_nan()/is_inf()
- $x->is_zero(); # true if arg is +0
- $x->is_nan(); # true if arg is NaN
- $x->is_one(); # true if arg is +1
- $x->is_one('-'); # true if arg is -1
- $x->is_inf(); # true if +inf
- $x->is_inf('-'); # true if -inf (sign is default '+')
+ $x->is_zero(); # true if arg is +0
+ $x->is_nan(); # true if arg is NaN
+ $x->is_one(); # true if arg is +1
+ $x->is_one('-'); # true if arg is -1
+ $x->is_inf(); # true if +inf
+ $x->is_inf('-'); # true if -inf (sign is default '+')
These methods all test the BigInt for being one specific value and return
true or false depending on the input. These are faster than doing something
@@ -3973,8 +4069,8 @@ like:
=item is_pos()/is_neg()/is_positive()/is_negative()
- $x->is_pos(); # true if > 0
- $x->is_neg(); # true if < 0
+ $x->is_pos(); # true if > 0
+ $x->is_neg(); # true if < 0
The methods return true if the argument is positive or negative, respectively.
C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
@@ -3989,9 +4085,9 @@ in v1.68.
=item is_odd()/is_even()/is_int()
- $x->is_odd(); # true if odd, false for even
- $x->is_even(); # true if even, false for odd
- $x->is_int(); # true if $x is an integer
+ $x->is_odd(); # true if odd, false for even
+ $x->is_even(); # true if even, false for odd
+ $x->is_int(); # true if $x is an integer
The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
C<-inf> are not integers and are neither odd nor even.
@@ -4019,15 +4115,15 @@ Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
If you want $x to have a certain sign, use one of the following methods:
- $x->babs(); # '+'
- $x->babs()->bneg(); # '-'
- $x->bnan(); # 'NaN'
- $x->binf(); # '+inf'
- $x->binf('-'); # '-inf'
+ $x->babs(); # '+'
+ $x->babs()->bneg(); # '-'
+ $x->bnan(); # 'NaN'
+ $x->binf(); # '+inf'
+ $x->binf('-'); # '-inf'
=item digit()
- $x->digit($n); # return the nth digit, counting from right
+ $x->digit($n); # return the nth digit, counting from right
If C<$n> is negative, returns the digit counting from left.
@@ -4055,7 +4151,7 @@ number is negative, zero, or positive, respectively. Does not modify NaNs.
=item bnorm()
- $x->bnorm(); # normalize (no-op)
+ $x->bnorm(); # normalize (no-op)
=item bnot()
@@ -4069,23 +4165,23 @@ but faster.
=item binc()
- $x->binc(); # increment x by 1
+ $x->binc(); # increment x by 1
=item bdec()
- $x->bdec(); # decrement x by 1
+ $x->bdec(); # decrement x by 1
=item badd()
- $x->badd($y); # addition (add $y to $x)
+ $x->badd($y); # addition (add $y to $x)
=item bsub()
- $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
=item bmul()
- $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bmul($y); # multiplication (multiply $x by $y)
=item bmuladd()
@@ -4097,7 +4193,7 @@ This method was added in v1.87 of Math::BigInt (June 2007).
=item bdiv()
- $x->bdiv($y); # divide, set $x to quotient
+ $x->bdiv($y); # divide, set $x to quotient
Returns $x divided by $y. In list context, does floored division (F-division),
where the quotient is the greatest integer less than or equal to the quotient
@@ -4106,7 +4202,7 @@ sign as the second operand. In scalar context, only the quotient is returned.
=item bmod()
- $x->bmod($y); # modulus (x % y)
+ $x->bmod($y); # modulus (x % y)
Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
result is identical to the remainder after floored division (F-division), i.e.,
@@ -4114,7 +4210,7 @@ identical to the result from Perl's % operator.
=item bmodinv()
- $x->bmodinv($mod); # modular multiplicative inverse
+ $x->bmodinv($mod); # modular multiplicative inverse
Returns the multiplicative inverse of C<$x> modulo C<$mod>. If
@@ -4131,8 +4227,8 @@ inverse exists.
=item bmodpow()
- $num->bmodpow($exp,$mod); # modular exponentiation
- # ($num**$exp % $mod)
+ $num->bmodpow($exp,$mod); # modular exponentiation
+ # ($num**$exp % $mod)
Returns the value of C<$num> taken to the power C<$exp> in the modulus
C<$mod> using binary exponentiation. C<bmodpow> is far superior to
@@ -4153,7 +4249,7 @@ is exactly equivalent to
=item bpow()
- $x->bpow($y); # power of arguments (x ** y)
+ $x->bpow($y); # power of arguments (x ** y)
=item blog()
@@ -4165,7 +4261,7 @@ If C<$base> is not defined, Euler's number (e) is used:
=item bexp()
- $x->bexp($accuracy); # calculate e ** X
+ $x->bexp($accuracy); # calculate e ** X
Calculates the expression C<e ** $x> where C<e> is Euler's number.
@@ -4175,20 +4271,20 @@ See also L</blog()>.
=item bnok()
- $x->bnok($y); # x over y (binomial coefficient n over k)
+ $x->bnok($y); # x over y (binomial coefficient n over k)
Calculates the binomial coefficient n over k, also called the "choose"
function. The result is equivalent to:
- ( n ) n!
- | - | = -------
- ( k ) k!(n-k)!
+ ( n ) n!
+ | - | = -------
+ ( k ) k!(n-k)!
This method was added in v1.84 of Math::BigInt (April 2007).
=item bpi()
- print Math::BigInt->bpi(100), "\n"; # 3
+ print Math::BigInt->bpi(100), "\n"; # 3
Returns PI truncated to an integer, with the argument being ignored. This means
under BigInt this always returns C<3>.
@@ -4198,8 +4294,8 @@ current rounding mode:
use Math::BigFloat;
use Math::BigInt upgrade => Math::BigFloat;
- print Math::BigInt->bpi(3), "\n"; # 3.14
- print Math::BigInt->bpi(100), "\n"; # 3.1415....
+ print Math::BigInt->bpi(3), "\n"; # 3.14
+ print Math::BigInt->bpi(100), "\n"; # 3.1415....
This method was added in v1.87 of Math::BigInt (June 2007).
@@ -4254,33 +4350,33 @@ This method was added in v1.87 of Math::BigInt (June 2007).
=item blsft()
- $x->blsft($y); # left shift in base 2
- $x->blsft($y,$n); # left shift, in base $n (like 10)
+ $x->blsft($y); # left shift in base 2
+ $x->blsft($y,$n); # left shift, in base $n (like 10)
=item brsft()
- $x->brsft($y); # right shift in base 2
- $x->brsft($y,$n); # right shift, in base $n (like 10)
+ $x->brsft($y); # right shift in base 2
+ $x->brsft($y,$n); # right shift, in base $n (like 10)
=item band()
- $x->band($y); # bitwise and
+ $x->band($y); # bitwise and
=item bior()
- $x->bior($y); # bitwise inclusive or
+ $x->bior($y); # bitwise inclusive or
=item bxor()
- $x->bxor($y); # bitwise exclusive or
+ $x->bxor($y); # bitwise exclusive or
=item bnot()
- $x->bnot(); # bitwise not (two's complement)
+ $x->bnot(); # bitwise not (two's complement)
=item bsqrt()
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square-root
=item broot()
@@ -4290,7 +4386,7 @@ Calculates the N'th root of C<$x>.
=item bfac()
- $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
=item round()
@@ -4313,12 +4409,12 @@ is a no-op for them.
Examples:
- Input N Result
- ===================================================
- 123456.123456 3 123500
- 123456.123456 2 123450
- 123456.123456 -2 123456.12
- 123456.123456 -3 123456.123
+ Input N Result
+ ===================================================
+ 123456.123456 3 123500
+ 123456.123456 2 123450
+ 123456.123456 -2 123456.12
+ 123456.123456 -3 123456.123
=item bfloor()
@@ -4345,11 +4441,11 @@ if $x is not an integer.
=item bgcd()
- bgcd(@values); # greatest common divisor (no OO style)
+ bgcd(@values); # greatest common divisor (no OO style)
=item blcm()
- blcm(@values); # lowest common multiple (no OO style)
+ blcm(@values); # lowest common multiple (no OO style)
=item length()
@@ -4374,11 +4470,11 @@ Return the signed mantissa of $x as BigInt.
=item parts()
- $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
=item copy()
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
=item as_int()
@@ -4428,7 +4524,7 @@ Returns a normalized string representation of C<$x>.
=item numify()
- print $x->numify();
+ print $x->numify();
This returns a normal Perl scalar from $x. It is used automatically
whenever a scalar is needed, for instance in array index operations.
@@ -4450,10 +4546,10 @@ Set/get the class for downgrade/upgrade operations. Thuis is used
for instance by L<bignum>. The defaults are '', thus the following
operation will create a BigInt, not a BigFloat:
- my $i = Math::BigInt->new(123);
- my $f = Math::BigFloat->new('123.1');
+ my $i = Math::BigInt->new(123);
+ my $f = Math::BigFloat->new('123.1');
- print $i + $f,"\n"; # print 246
+ print $i + $f,"\n"; # print 246
=item div_scale()
@@ -4498,15 +4594,15 @@ are zero.
The string output (of floating point numbers) will be padded with zeros:
- Initial value P A Result String
- ------------------------------------------------------------
- 1234.01 -3 1000 1000
- 1234 -2 1200 1200
- 1234.5 -1 1230 1230
- 1234.001 1 1234 1234.0
- 1234.01 0 1234 1234
- 1234.01 2 1234.01 1234.01
- 1234.01 5 1234.01 1234.01000
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 -3 1000 1000
+ 1234 -2 1200 1200
+ 1234.5 -1 1230 1230
+ 1234.001 1 1234 1234.0
+ 1234.01 0 1234 1234
+ 1234.01 2 1234.01 1234.01
+ 1234.01 5 1234.01 1234.01000
For BigInts, no padding occurs.
@@ -4519,11 +4615,11 @@ A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
The string output (of floating point numbers) will be padded with zeros:
- Initial value P A Result String
- ------------------------------------------------------------
- 1234.01 3 1230 1230
- 1234.01 6 1234.01 1234.01
- 1234.1 8 1234.1 1234.1000
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 3 1230 1230
+ 1234.01 6 1234.01 1234.01
+ 1234.1 8 1234.1 1234.1000
For BigInts, no padding occurs.
@@ -4690,12 +4786,12 @@ This is how it works now:
globals enforced upon creation of a number by using
$x = Math::BigInt->new($number,undef,undef):
- use Math::BigInt::SomeSubclass;
- use Math::BigInt;
+ use Math::BigInt::SomeSubclass;
+ use Math::BigInt;
- Math::BigInt->accuracy(2);
- Math::BigInt::SomeSubClass->accuracy(3);
- $x = Math::BigInt::SomeSubClass->new(1234);
+ Math::BigInt->accuracy(2);
+ Math::BigInt::SomeSubClass->accuracy(3);
+ $x = Math::BigInt::SomeSubClass->new(1234);
$x is now 1230, and not 1200. A subclass might choose to implement
this otherwise, e.g. falling back to the parent's A and P.
@@ -4838,15 +4934,15 @@ While BigInt has extensive handling of inf and NaN, certain quirks remain.
These perl routines currently (as of Perl v.5.8.6) cannot handle passed
inf.
- te@linux:~> perl -wle 'print 2 ** 3333'
- inf
- te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
- 1
- te@linux:~> perl -wle 'print oct(2 ** 3333)'
- 0
- te@linux:~> perl -wle 'print hex(2 ** 3333)'
- Illegal hexadecimal digit 'i' ignored at -e line 1.
- 0
+ te@linux:~> perl -wle 'print 2 ** 3333'
+ Inf
+ te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
+ 1
+ te@linux:~> perl -wle 'print oct(2 ** 3333)'
+ 0
+ te@linux:~> perl -wle 'print hex(2 ** 3333)'
+ Illegal hexadecimal digit 'I' ignored at -e line 1.
+ 0
The same problems occur if you pass them Math::BigInt->binf() objects. Since
overloading these routines is not possible, this cannot be fixed from BigInt.
@@ -4885,11 +4981,11 @@ instead relying on the internal representation.
Math with the numbers is done (by default) by a module called
C<Math::BigInt::Calc>. This is equivalent to saying:
- use Math::BigInt try => 'Calc';
+ use Math::BigInt try => 'Calc';
You can change this backend library by using:
- use Math::BigInt try => 'GMP';
+ use Math::BigInt try => 'GMP';
B<Note>: General purpose packages should not be explicit about the library
to use; let the script author decide which is best.
@@ -4898,12 +4994,12 @@ If your script works with huge numbers and Calc is too slow for them,
you can also for the loading of one of these libraries and if none
of them can be used, the code will die:
- use Math::BigInt only => 'GMP,Pari';
+ use Math::BigInt only => 'GMP,Pari';
The following would first try to find Math::BigInt::Foo, then
Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
- use Math::BigInt try => 'Foo,Math::BigInt::Bar';
+ use Math::BigInt try => 'Foo,Math::BigInt::Bar';
The library that is loaded last will be used. Note that this can be
overwritten at any time by loading a different library, and numbers
@@ -4966,21 +5062,21 @@ change.
sub bigint { Math::BigInt->new(shift); }
- $x = Math::BigInt->bstr("1234") # string "1234"
- $x = "$x"; # same as bstr()
- $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
- $x = Math::BigInt->babs("-12345"); # BigInt "12345"
- $x = Math::BigInt->bnorm("-0.00"); # BigInt "0"
+ $x = Math::BigInt->bstr("1234") # string "1234"
+ $x = "$x"; # same as bstr()
+ $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
+ $x = Math::BigInt->babs("-12345"); # BigInt "12345"
+ $x = Math::BigInt->bnorm("-0.00"); # BigInt "0"
$x = bigint(1) + bigint(2); # BigInt "3"
$x = bigint(1) + "2"; # ditto (auto-BigIntify of "2")
$x = bigint(1); # BigInt "1"
- $x = $x + 5 / 2; # BigInt "3"
- $x = $x ** 3; # BigInt "27"
- $x *= 2; # BigInt "54"
- $x = Math::BigInt->new(0); # BigInt "0"
- $x--; # BigInt "-1"
- $x = Math::BigInt->badd(4,5) # BigInt "9"
- print $x->bsstr(); # 9e+0
+ $x = $x + 5 / 2; # BigInt "3"
+ $x = $x ** 3; # BigInt "27"
+ $x *= 2; # BigInt "54"
+ $x = Math::BigInt->new(0); # BigInt "0"
+ $x--; # BigInt "-1"
+ $x = Math::BigInt->badd(4,5) # BigInt "9"
+ print $x->bsstr(); # 9e+0
Examples for rounding:
@@ -4989,22 +5085,22 @@ Examples for rounding:
$x = Math::BigFloat->new(123.4567);
$y = Math::BigFloat->new(123.456789);
- Math::BigFloat->accuracy(4); # no more A than 4
-
- is ($x->copy()->bround(),123.4); # even rounding
- print $x->copy()->bround(),"\n"; # 123.4
- Math::BigFloat->round_mode('odd'); # round to odd
- print $x->copy()->bround(),"\n"; # 123.5
- Math::BigFloat->accuracy(5); # no more A than 5
- Math::BigFloat->round_mode('odd'); # round to odd
- print $x->copy()->bround(),"\n"; # 123.46
- $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4
- print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
-
- Math::BigFloat->accuracy(undef); # A not important now
- Math::BigFloat->precision(2); # P important
- print $x->copy()->bnorm(),"\n"; # 123.46
- print $x->copy()->bround(),"\n"; # 123.46
+ Math::BigFloat->accuracy(4); # no more A than 4
+
+ is ($x->copy()->bround(),123.4); # even rounding
+ print $x->copy()->bround(),"\n"; # 123.4
+ Math::BigFloat->round_mode('odd'); # round to odd
+ print $x->copy()->bround(),"\n"; # 123.5
+ Math::BigFloat->accuracy(5); # no more A than 5
+ Math::BigFloat->round_mode('odd'); # round to odd
+ print $x->copy()->bround(),"\n"; # 123.46
+ $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4
+ print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
+
+ Math::BigFloat->accuracy(undef); # A not important now
+ Math::BigFloat->precision(2); # P important
+ print $x->copy()->bnorm(),"\n"; # 123.46
+ print $x->copy()->bround(),"\n"; # 123.46
Examples for converting:
@@ -5015,31 +5111,31 @@ Examples for converting:
After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
and binary constants in the given scope are converted to C<Math::BigInt>.
-This conversion happens at compile time.
+This conversion happens at compile time.
In particular,
perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
-prints the integer value of C<2**100>. Note that without conversion of
+prints the integer value of C<2**100>. Note that without conversion of
constants the expression 2**100 will be calculated as perl scalar.
Please note that strings and floating point constants are not affected,
so that
- use Math::BigInt qw/:constant/;
+ use Math::BigInt qw/:constant/;
- $x = 1234567890123456789012345678901234567890
- + 123456789123456789;
- $y = '1234567890123456789012345678901234567890'
- + '123456789123456789';
+ $x = 1234567890123456789012345678901234567890
+ + 123456789123456789;
+ $y = '1234567890123456789012345678901234567890'
+ + '123456789123456789';
do not work. You need an explicit Math::BigInt->new() around one of the
operands. You should also quote large constants to protect loss of precision:
- use Math::BigInt;
+ use Math::BigInt;
- $x = Math::BigInt->new('1234567889123456789123456789123456789');
+ $x = Math::BigInt->new('1234567889123456789123456789123456789');
Without the quotes Perl would convert the large number to a floating point
constant at compile time and then hand the result to BigInt, which results in
@@ -5047,10 +5143,10 @@ an truncated result or a NaN.
This also applies to integers that look like floating point constants:
- use Math::BigInt ':constant';
+ use Math::BigInt ':constant';
- print ref(123e2),"\n";
- print ref(123.2e2),"\n";
+ print ref(123e2),"\n";
+ print ref(123.2e2),"\n";
will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
to get this to work.
@@ -5082,7 +5178,7 @@ C<babs()> etc), instead of O(N) and thus nearly always take much less time.
These optimizations were done on purpose.
If you find the Calc module to slow, try to install any of the replacement
-modules and see if they help you.
+modules and see if they help you.
=head2 Alternative math libraries
@@ -5123,7 +5219,7 @@ to support different storage methods.
More complex sub-classes may have to replicate more of the logic internal of
Math::BigInt if they need to change more basic behaviors. A subclass that
-needs to merely change the output only needs to overload C<bstr()>.
+needs to merely change the output only needs to overload C<bstr()>.
All other object methods and overloaded functions can be directly inherited
from the parent class.
@@ -5144,13 +5240,13 @@ auto-upgrading and auto-downgrading to work correctly:
$upgrade = undef;
$downgrade = undef;
-This allows Math::BigInt to correctly retrieve package globals from the
+This allows Math::BigInt to correctly retrieve package globals from the
subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
t/Math/BigFloat/SubClass.pm completely functional subclass examples.
-Don't forget to
+Don't forget to
- use overload;
+ use overload;
in your subclass to automatically inherit the overloading from the parent. If
you like, you can change part of the overloading, look at Math::String for an
@@ -5160,20 +5256,20 @@ example.
When used like this:
- use Math::BigInt upgrade => 'Foo::Bar';
+ use Math::BigInt upgrade => 'Foo::Bar';
certain operations will 'upgrade' their calculation and thus the result to
the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
- use Math::BigInt upgrade => 'Math::BigFloat';
+ use Math::BigInt upgrade => 'Math::BigFloat';
As a shortcut, you can use the module L<bignum>:
- use bignum;
+ use bignum;
Also good for one-liners:
- perl -Mbignum -le 'print 2 ** 255'
+ perl -Mbignum -le 'print 2 ** 255'
This makes it possible to mix arguments of different classes (as in 2.5 + 2)
as well es preserve accuracy (as in sqrt(3)).
@@ -5214,8 +5310,8 @@ arguments are of the class mentioned in $upgrade.
C<Math::BigInt> exports nothing by default, but can export the following methods:
- bgcd
- blcm
+ bgcd
+ blcm
=head1 CAVEATS
@@ -5235,44 +5331,44 @@ and L<Test::More>, which stringify arguments before comparing them.
Mark Biggar said, when asked about to drop the '+' altogether, or make only
C<cmp> work:
- I agree (with the first alternative), don't add the '+' on positive
- numbers. It's not as important anymore with the new internal
- form for numbers. It made doing things like abs and neg easier,
- but those have to be done differently now anyway.
+ I agree (with the first alternative), don't add the '+' on positive
+ numbers. It's not as important anymore with the new internal
+ form for numbers. It made doing things like abs and neg easier,
+ but those have to be done differently now anyway.
So, the following examples will now work all as expected:
- use Test::More tests => 1;
- use Math::BigInt;
+ use Test::More tests => 1;
+ use Math::BigInt;
- my $x = Math::BigInt -> new(3*3);
- my $y = Math::BigInt -> new(3*3);
+ my $x = Math::BigInt -> new(3*3);
+ my $y = Math::BigInt -> new(3*3);
- is ($x,3*3, 'multiplication');
- print "$x eq 9" if $x eq $y;
- print "$x eq 9" if $x eq '9';
- print "$x eq 9" if $x eq 3*3;
+ is ($x,3*3, 'multiplication');
+ print "$x eq 9" if $x eq $y;
+ print "$x eq 9" if $x eq '9';
+ print "$x eq 9" if $x eq 3*3;
Additionally, the following still works:
- print "$x == 9" if $x == $y;
- print "$x == 9" if $x == 9;
- print "$x == 9" if $x == 3*3;
+ print "$x == 9" if $x == $y;
+ print "$x == 9" if $x == 9;
+ print "$x == 9" if $x == 3*3;
There is now a C<bsstr()> method to get the string in scientific notation aka
C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
for comparison, but Perl will represent some numbers as 100 and others
-as 1e+308. If in doubt, convert both arguments to Math::BigInt before
+as 1e+308. If in doubt, convert both arguments to Math::BigInt before
comparing them as strings:
- use Test::More tests => 3;
- use Math::BigInt;
+ use Test::More tests => 3;
+ use Math::BigInt;
- $x = Math::BigInt->new('1e56'); $y = 1e56;
- is ($x,$y); # will fail
- is ($x->bsstr(),$y); # okay
- $y = Math::BigInt->new($y);
- is ($x,$y); # okay
+ $x = Math::BigInt->new('1e56'); $y = 1e56;
+ is ($x,$y); # will fail
+ is ($x->bsstr(),$y); # okay
+ $y = Math::BigInt->new($y);
+ is ($x,$y); # okay
Alternatively, simply use C<< <=> >> for comparisons, this will get it
always right. There is not yet a way to get a number automatically represented
@@ -5283,77 +5379,77 @@ comparing NaNs.
=item int()
-C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
+C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
Perl scalar:
- $x = Math::BigInt->new(123);
- $y = int($x); # BigInt 123
- $x = Math::BigFloat->new(123.45);
- $y = int($x); # BigInt 123
+ $x = Math::BigInt->new(123);
+ $y = int($x); # BigInt 123
+ $x = Math::BigFloat->new(123.45);
+ $y = int($x); # BigInt 123
In all Perl versions you can use C<as_number()> or C<as_int> for the same
effect:
- $x = Math::BigFloat->new(123.45);
- $y = $x->as_number(); # BigInt 123
- $y = $x->as_int(); # ditto
+ $x = Math::BigFloat->new(123.45);
+ $y = $x->as_number(); # BigInt 123
+ $y = $x->as_int(); # ditto
This also works for other subclasses, like Math::String.
If you want a real Perl scalar, use C<numify()>:
- $y = $x->numify(); # 123 as scalar
+ $y = $x->numify(); # 123 as scalar
This is seldom necessary, though, because this is done automatically, like
when you access an array:
- $z = $array[$x]; # does work automatically
+ $z = $array[$x]; # does work automatically
=item length()
The following will probably not do what you expect:
- $c = Math::BigInt->new(123);
- print $c->length(),"\n"; # prints 30
+ $c = Math::BigInt->new(123);
+ print $c->length(),"\n"; # prints 30
It prints both the number of digits in the number and in the fraction part
-since print calls C<length()> in list context. Use something like:
+since print calls C<length()> in list context. Use something like:
- print scalar $c->length(),"\n"; # prints 3
+ print scalar $c->length(),"\n"; # prints 3
=item bdiv()
The following will probably not do what you expect:
- print $c->bdiv(10000),"\n";
+ print $c->bdiv(10000),"\n";
It prints both quotient and remainder since print calls C<bdiv()> in list
context. Also, C<bdiv()> will modify $c, so be careful. You probably want
to use
- print $c / 10000,"\n";
+ print $c / 10000,"\n";
or, if you want to modify $c instead,
- print scalar $c->bdiv(10000),"\n";
+ print scalar $c->bdiv(10000),"\n";
The quotient is always the greatest integer less than or equal to the
real-valued quotient of the two operands, and the remainder (when it is
non-zero) always has the same sign as the second operand; so, for
example,
- 1 / 4 => ( 0, 1)
- 1 / -4 => (-1,-3)
- -3 / 4 => (-1, 1)
- -3 / -4 => ( 0,-3)
- -11 / 2 => (-5,1)
- 11 /-2 => (-5,-1)
+ 1 / 4 => ( 0, 1)
+ 1 / -4 => (-1,-3)
+ -3 / 4 => (-1, 1)
+ -3 / -4 => ( 0,-3)
+ -11 / 2 => (-5,1)
+ 11 /-2 => (-5,-1)
As a consequence, the behavior of the operator % agrees with the
behavior of Perl's built-in % operator (as documented in the perlop
manpage), and the equation
- $x == ($x / $y) * $y + ($x % $y)
+ $x == ($x / $y) * $y + ($x % $y)
holds true for any $x and $y, which justifies calling the two return
values of bdiv() the quotient and remainder. The only exception to this rule
@@ -5375,37 +5471,37 @@ The following table shows the result of the division and the remainder, so that
the equation above holds true. Some "ordinary" cases are strewn in to show more
clearly the reasoning:
- A / B = C, R so that C * B + R = A
+ A / B = C, R so that C * B + R = A
=========================================================
- 5 / 8 = 0, 5 0 * 8 + 5 = 5
- 0 / 8 = 0, 0 0 * 8 + 0 = 0
- 0 / inf = 0, 0 0 * inf + 0 = 0
- 0 /-inf = 0, 0 0 * -inf + 0 = 0
- 5 / inf = 0, 5 0 * inf + 5 = 5
- 5 /-inf = 0, 5 0 * -inf + 5 = 5
- -5/ inf = 0, -5 0 * inf + -5 = -5
- -5/-inf = 0, -5 0 * -inf + -5 = -5
- inf/ 5 = inf, 0 inf * 5 + 0 = inf
+ 5 / 8 = 0, 5 0 * 8 + 5 = 5
+ 0 / 8 = 0, 0 0 * 8 + 0 = 0
+ 0 / inf = 0, 0 0 * inf + 0 = 0
+ 0 /-inf = 0, 0 0 * -inf + 0 = 0
+ 5 / inf = 0, 5 0 * inf + 5 = 5
+ 5 /-inf = 0, 5 0 * -inf + 5 = 5
+ -5/ inf = 0, -5 0 * inf + -5 = -5
+ -5/-inf = 0, -5 0 * -inf + -5 = -5
+ inf/ 5 = inf, 0 inf * 5 + 0 = inf
-inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
- inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
+ inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
-inf/ -5 = inf, 0 inf * -5 + 0 = -inf
- 5/ 5 = 1, 0 1 * 5 + 0 = 5
- -5/ -5 = 1, 0 1 * -5 + 0 = -5
+ 5/ 5 = 1, 0 1 * 5 + 0 = 5
+ -5/ -5 = 1, 0 1 * -5 + 0 = -5
inf/ inf = 1, 0 1 * inf + 0 = inf
-inf/-inf = 1, 0 1 * -inf + 0 = -inf
inf/-inf = -1, 0 -1 * -inf + 0 = inf
-inf/ inf = -1, 0 1 * -inf + 0 = -inf
- 8/ 0 = inf, 8 inf * 0 + 8 = 8
+ 8/ 0 = inf, 8 inf * 0 + 8 = 8
inf/ 0 = inf, inf inf * 0 + inf = inf
0/ 0 = NaN
These cases below violate the "remainder has the sign of the second of the two
arguments", since they wouldn't match up otherwise.
- A / B = C, R so that C * B + R = A
+ A / B = C, R so that C * B + R = A
========================================================
-inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
- -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
+ -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
=item Modifying and =
@@ -5441,10 +5537,10 @@ returns it, unlike the old code which left it alone and only returned the
result. This is to be consistent with C<badd()> etc. The first three will
modify $x, the last one won't:
- print bpow($x,$i),"\n"; # modify $x
- print $x->bpow($i),"\n"; # ditto
- print $x **= $i,"\n"; # the same
- print $x ** $i,"\n"; # leave $x alone
+ print bpow($x,$i),"\n"; # modify $x
+ print $x->bpow($i),"\n"; # ditto
+ print $x **= $i,"\n"; # the same
+ print $x ** $i,"\n"; # leave $x alone
The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
@@ -5452,11 +5548,11 @@ The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
The following:
- $x = -$x;
+ $x = -$x;
is slower than
- $x->bneg();
+ $x->bneg();
since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
needs to preserve $x since it does not know that it later will get overwritten.
@@ -5468,13 +5564,13 @@ With overloaded operators, it is the first (dominating) operand that determines
which method is called. Here are some examples showing what actually gets
called in various cases.
- use Math::BigInt;
- use Math::BigFloat;
+ use Math::BigInt;
+ use Math::BigFloat;
- $mbf = Math::BigFloat->new(5);
- $mbi2 = Math::BigInt->new(5);
- $mbi = Math::BigInt->new(2);
- # what actually gets called:
+ $mbf = Math::BigFloat->new(5);
+ $mbi2 = Math::BigInt->new(5);
+ $mbi = Math::BigInt->new(2);
+ # what actually gets called:
$float = $mbf + $mbi; # $mbf->badd($mbi)
$float = $mbf / $mbi; # $mbf->bdiv($mbi)
$integer = $mbi + $mbf; # $mbi->badd($mbf)
@@ -5486,25 +5582,25 @@ whether the second operant is a Math::BigFloat. To get a Math::BigFloat you
either need to call the operation manually, make sure each operand already is a
Math::BigFloat, or cast to that type via Math::BigFloat->new():
- $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
+ $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
Beware of casting the entire expression, as this would cast the
result, at which point it is too late:
- $float = Math::BigFloat->new($mbi2 / $mbi); # = 2
+ $float = Math::BigFloat->new($mbi2 / $mbi); # = 2
Beware also of the order of more complicated expressions like:
- $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
- $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
+ $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
+ $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
If in doubt, break the expression into simpler terms, or cast all operands
to the desired resulting type.
Scalar values are a bit different, since:
- $float = 2 + $mbf;
- $float = $mbf + 2;
+ $float = 2 + $mbf;
+ $float = $mbf + 2;
will both result in the proper type due to the way the overloaded math works.
@@ -5521,14 +5617,14 @@ mode. The reason is that the result is always truncated to an integer.
If you want a better approximation of the square root, then use:
- $x = Math::BigFloat->new(12);
- Math::BigFloat->precision(0);
- Math::BigFloat->round_mode('even');
- print $x->copy->bsqrt(),"\n"; # 4
+ $x = Math::BigFloat->new(12);
+ Math::BigFloat->precision(0);
+ Math::BigFloat->round_mode('even');
+ print $x->copy->bsqrt(),"\n"; # 4
- Math::BigFloat->precision(2);
- print $x->bsqrt(),"\n"; # 3.46
- print $x->bsqrt(3),"\n"; # 3.464
+ Math::BigFloat->precision(2);
+ print $x->bsqrt(),"\n"; # 3.46
+ print $x->bsqrt(3),"\n"; # 3.464
=item brsft()
diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm
index 46b41e1708..2217b92ca3 100644
--- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm
+++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm
@@ -1,10 +1,11 @@
package Math::BigInt::Calc;
-use 5.006002;
+use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999710';
+our $VERSION = '1.999714';
+$VERSION = eval $VERSION;
# Package to store unsigned big integers in decimal and do math with them
@@ -98,20 +99,24 @@ sub _base_len
return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL);
}
-sub _new
- {
- # (ref to string) return ref to num_array
- # Convert a number from string format (without sign) to internal base
- # 1ex format. Assumes normalized value as input.
- my $il = length($_[1])-1;
+sub _new {
+ # Given a string representing an integer, returns a reference to an array
+ # of integers, where each integer represents a chunk of the original input
+ # integer. Assumes normalized value as input.
- # < BASE_LEN due len-1 above
- return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers
+ my ($proto, $str) = @_;
- # this leaves '00000' instead of int 0 and will be corrected after any op
- [ reverse(unpack("a" . ($il % $BASE_LEN+1)
- . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
- }
+ my $input_len = length($str) - 1;
+
+ # Shortcut for small numbers.
+ return [ int($str) ] if $input_len < $BASE_LEN;
+
+ my $format = "a" . (($input_len % $BASE_LEN) + 1);
+ $format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN)
+ : "(a$BASE_LEN)*";
+
+ [ reverse(map { 0 + $_ } unpack($format, $str)) ];
+}
BEGIN
{
@@ -119,11 +124,10 @@ BEGIN
# multipliable with itself plus carry
# Test now changed to expect the proper pattern, not a result off by 1 or 2
my ($e, $num) = 3; # lowest value we will use is 3+1-1 = 3
- do
- {
- $num = ('9' x ++$e) + 0;
- $num *= $num + 1.0;
- } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern
+ do {
+ $num = '9' x ++$e;
+ $num *= $num + 1;
+ } while $num =~ /9{$e}0{$e}/; # must be a certain pattern
$e--; # last test failed, so retract one step
# the limits below brush the problems with the test above under the rug:
# the test should be able to find the proper $e automatically
@@ -241,34 +245,32 @@ sub import { }
##############################################################################
# convert back to string and number
-sub _str
- {
- # (ref to BINT) return num_str
- # Convert number from internal base 100000 format to string format.
- # internal format is always normalized (no leading zeros, "-0" => "+0")
- my $ar = $_[1];
+sub _str {
+ # Convert number from internal base 1eN format to string format. Internal
+ # format is always normalized, i.e., no leading zeros.
- my $l = scalar @$ar; # number of parts
- if ($l < 1) # should not happen
- {
- require Carp;
- Carp::croak("$_[1] has no elements");
+ my $ary = $_[1];
+ my $idx = $#$ary; # index of last element
+
+ if ($idx < 0) { # should not happen
+ require Carp;
+ Carp::croak("$_[1] has no elements");
}
- my $ret = "";
- # handle first one different to strip leading zeros from it (there are no
- # leading zero parts in internal representation)
- $l --; $ret .= int($ar->[$l]); $l--;
- # Interestingly, the pre-padd method uses more time
- # the old grep variant takes longer (14 vs. 10 sec)
- my $z = '0' x ($BASE_LEN-1);
- while ($l >= 0)
- {
- $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
- $l--;
+ # Handle first one differently, since it should not have any leading zeros.
+ my $ret = int($ary->[$idx]);
+ if ($idx > 0) {
+ $idx--;
+ # Interestingly, the pre-padd method uses more time
+ # the old grep variant takes longer (14 vs. 10 sec)
+ my $z = '0' x ($BASE_LEN - 1);
+ while ($idx >= 0) {
+ $ret .= substr($z . $ary->[$idx], -$BASE_LEN);
+ $idx--;
+ }
}
- $ret;
- }
+ $ret;
+}
sub _num
{
@@ -293,100 +295,96 @@ sub _num
##############################################################################
# actual math code
-sub _add
- {
- # (ref to int_num_array, ref to int_num_array)
- # routine to add two base 1eX numbers
- # stolen from Knuth Vol 2 Algorithm A pg 231
- # there are separate routines to add and sub as per Knuth pg 233
- # This routine modifies array x, but not y.
-
- my ($c,$x,$y) = @_;
+sub _add {
+ # (ref to int_num_array, ref to int_num_array)
+ #
+ # Routine to add two base 1eX numbers stolen from Knuth Vol 2 Algorithm A
+ # pg 231. There are separate routines to add and sub as per Knuth pg 233.
+ # This routine modifies array x, but not y.
- return $x if (@$y == 1) && $y->[0] == 0; # $x + 0 => $x
- if ((@$x == 1) && $x->[0] == 0) # 0 + $y => $y->copy
- {
- # twice as slow as $x = [ @$y ], but nec. to retain $x as ref :(
- @$x = @$y; return $x;
+ my ($c, $x, $y) = @_;
+
+ return $x if @$y == 1 && $y->[0] == 0; # $x + 0 => $x
+ if (@$x == 1 && $x->[0] == 0) { # 0 + $y => $y->copy
+ # Twice as slow as $x = [ @$y ], but necessary to modify $x in-place.
+ @$x = @$y;
+ return $x;
}
-
- # for each in Y, add Y to X and carry. If after that, something is left in
- # X, foreach in X add carry to X and then return X, carry
- # Trades one "$j++" for having to shift arrays
- my $i; my $car = 0; my $j = 0;
- for $i (@$y)
- {
- $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
- $j++;
+
+ # For each in Y, add Y to X and carry. If after that, something is left in
+ # X, foreach in X add carry to X and then return X, carry. Trades one
+ # "$j++" for having to shift arrays.
+ my $i;
+ my $car = 0;
+ my $j = 0;
+ for $i (@$y) {
+ $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
+ $j++;
}
- while ($car != 0)
- {
- $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
+ while ($car != 0) {
+ $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0;
+ $j++;
}
- $x;
- }
+ $x;
+}
-sub _inc
- {
- # (ref to int_num_array, ref to int_num_array)
- # Add 1 to $x, modify $x in place
- my ($c,$x) = @_;
+sub _inc {
+ # (ref to int_num_array, ref to int_num_array)
+ # Add 1 to $x, modify $x in place
+ my ($c, $x) = @_;
- for my $i (@$x)
- {
- return $x if (($i += 1) < $BASE); # early out
- $i = 0; # overflow, next
+ for my $i (@$x) {
+ return $x if ($i += 1) < $BASE; # early out
+ $i = 0; # overflow, next
}
- push @$x,1 if (($x->[-1] || 0) == 0); # last overflowed, so extend
- $x;
- }
+ push @$x, 1 if $x->[-1] == 0; # last overflowed, so extend
+ $x;
+}
-sub _dec
- {
- # (ref to int_num_array, ref to int_num_array)
- # Sub 1 from $x, modify $x in place
- my ($c,$x) = @_;
+sub _dec {
+ # (ref to int_num_array, ref to int_num_array)
+ # Sub 1 from $x, modify $x in place
+ my ($c, $x) = @_;
- my $MAX = $BASE-1; # since MAX_VAL based on BASE
- for my $i (@$x)
- {
- last if (($i -= 1) >= 0); # early out
- $i = $MAX; # underflow, next
+ my $MAX = $BASE - 1; # since MAX_VAL based on BASE
+ for my $i (@$x) {
+ last if ($i -= 1) >= 0; # early out
+ $i = $MAX; # underflow, next
}
- pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0)
- $x;
- }
+ pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0)
+ $x;
+}
-sub _sub
- {
- # (ref to int_num_array, ref to int_num_array, swap)
- # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
- # subtract Y from X by modifying x in place
- my ($c,$sx,$sy,$s) = @_;
-
- my $car = 0; my $i; my $j = 0;
- if (!$s)
- {
- for $i (@$sx)
- {
- last unless defined $sy->[$j] || $car;
- $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++;
- }
- # might leave leading zeros, so fix that
- return __strip_zeros($sx);
+sub _sub {
+ # (ref to int_num_array, ref to int_num_array, swap)
+ #
+ # Subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+ # subtract Y from X by modifying x in place
+ my ($c, $sx, $sy, $s) = @_;
+
+ my $car = 0;
+ my $i;
+ my $j = 0;
+ if (!$s) {
+ for $i (@$sx) {
+ last unless defined $sy->[$j] || $car;
+ $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0);
+ $j++;
+ }
+ # might leave leading zeros, so fix that
+ return __strip_zeros($sx);
}
- for $i (@$sx)
- {
- # we can't do an early out if $x is < than $y, since we
- # need to copy the high chunks from $y. Found by Bob Mathews.
- #last unless defined $sy->[$j] || $car;
- $sy->[$j] += $BASE
- if $car = (($sy->[$j] = $i-($sy->[$j]||0) - $car) < 0);
- $j++;
+ for $i (@$sx) {
+ # We can't do an early out if $x < $y, since we need to copy the high
+ # chunks from $y. Found by Bob Mathews.
+ #last unless defined $sy->[$j] || $car;
+ $sy->[$j] += $BASE
+ if $car = ($sy->[$j] = $i - ($sy->[$j] || 0) - $car) < 0;
+ $j++;
}
- # might leave leading zeros, so fix that
- __strip_zeros($sy);
- }
+ # might leave leading zeros, so fix that
+ __strip_zeros($sy);
+}
sub _mul_use_mul
{
@@ -1169,373 +1167,355 @@ sub _div_use_div
##############################################################################
# testing
-sub _acmp
- {
- # internal absolute post-normalized compare (ignore signs)
- # ref to array, ref to array, return <0, 0, >0
- # arrays must have at least one entry; this is not checked for
- my ($c,$cx,$cy) = @_;
-
- # shortcut for short numbers
- return (($cx->[0] <=> $cy->[0]) <=> 0)
- if scalar @$cx == scalar @$cy && scalar @$cx == 1;
-
- # fast comp based on number of array elements (aka pseudo-length)
- my $lxy = (scalar @$cx - scalar @$cy)
- # or length of first element if same number of elements (aka difference 0)
- ||
- # need int() here because sometimes the last element is '00018' vs '18'
- (length(int($cx->[-1])) - length(int($cy->[-1])));
- return -1 if $lxy < 0; # already differs, ret
- return 1 if $lxy > 0; # ditto
-
- # manual way (abort if unequal, good for early ne)
- my $a; my $j = scalar @$cx;
- while (--$j >= 0)
- {
- last if ($a = $cx->[$j] - $cy->[$j]);
- }
- $a <=> 0;
- }
+sub _acmp {
+ # Internal absolute post-normalized compare (ignore signs)
+ # ref to array, ref to array, return <0, 0, >0
+ # Arrays must have at least one entry; this is not checked for.
+ my ($c, $cx, $cy) = @_;
+
+ # shortcut for short numbers
+ return (($cx->[0] <=> $cy->[0]) <=> 0)
+ if @$cx == @$cy && @$cx == 1;
+
+ # fast comp based on number of array elements (aka pseudo-length)
+ my $lxy = (@$cx - @$cy)
+ # or length of first element if same number of elements (aka difference 0)
+ ||
+ # need int() here because sometimes the last element is '00018' vs '18'
+ (length(int($cx->[-1])) - length(int($cy->[-1])));
+
+ return -1 if $lxy < 0; # already differs, ret
+ return 1 if $lxy > 0; # ditto
+
+ # manual way (abort if unequal, good for early ne)
+ my $a;
+ my $j = @$cx;
+ while (--$j >= 0) {
+ last if $a = $cx->[$j] - $cy->[$j];
+ }
+ $a <=> 0;
+}
-sub _len
- {
- # compute number of digits in base 10
+sub _len {
+ # compute number of digits in base 10
- # int() because add/sub sometimes leaves strings (like '00005') instead of
- # '5' in this place, thus causing length() to report wrong length
- my $cx = $_[1];
+ # int() because add/sub sometimes leaves strings (like '00005') instead of
+ # '5' in this place, thus causing length() to report wrong length
+ my $cx = $_[1];
- (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
- }
+ (@$cx - 1) * $BASE_LEN + length(int($cx->[-1]));
+}
-sub _digit
- {
- # Return the nth digit. Zero is rightmost, so _digit(123,0) gives 3.
- # Negative values count from the left, so _digit(123, -1) gives 1.
- my ($c,$x,$n) = @_;
+sub _digit {
+ # Return the nth digit. Zero is rightmost, so _digit(123,0) gives 3.
+ # Negative values count from the left, so _digit(123, -1) gives 1.
+ my ($c, $x, $n) = @_;
- my $len = _len('',$x);
+ my $len = _len('', $x);
- $n += $len if $n < 0; # -1 last, -2 second-to-last
- return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range
+ $n += $len if $n < 0; # -1 last, -2 second-to-last
+ return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range
- my $elem = int($n / $BASE_LEN); # which array element
- my $digit = $n % $BASE_LEN; # which digit in this element
- substr("$x->[$elem]", -$digit-1, 1);
- }
+ my $elem = int($n / $BASE_LEN); # which array element
+ my $digit = $n % $BASE_LEN; # which digit in this element
+ substr("$x->[$elem]", -$digit - 1, 1);
+}
-sub _zeros
- {
- # return amount of trailing zeros in decimal
- # check each array elem in _m for having 0 at end as long as elem == 0
- # Upon finding a elem != 0, stop
- my $x = $_[1];
+sub _zeros {
+ # Return number of trailing zeros in decimal.
+ # Check each array element for having 0 at end as long as elem == 0
+ # Upon finding a elem != 0, stop.
- return 0 if scalar @$x == 1 && $x->[0] == 0;
+ my $x = $_[1];
- my $zeros = 0; my $elem;
- foreach my $e (@$x)
- {
- if ($e != 0)
- {
- $elem = "$e"; # preserve x
- $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
- $zeros *= $BASE_LEN; # elems * 5
- $zeros += length($elem); # count trailing zeros
- last; # early out
- }
- $zeros ++; # real else branch: 50% slower!
+ return 0 if @$x == 1 && $x->[0] == 0;
+
+ my $zeros = 0;
+ my $elem;
+ foreach my $e (@$x) {
+ if ($e != 0) {
+ $elem = "$e"; # preserve x
+ $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
+ $zeros *= $BASE_LEN; # elems * 5
+ $zeros += length($elem); # count trailing zeros
+ last; # early out
+ }
+ $zeros ++; # real else branch: 50% slower!
}
- $zeros;
- }
+ $zeros;
+}
##############################################################################
# _is_* routines
-sub _is_zero
- {
- # return true if arg is zero
- (((scalar @{$_[1]} == 1) && ($_[1]->[0] == 0))) <=> 0;
- }
+sub _is_zero {
+ # return true if arg is zero
+ @{$_[1]} == 1 && $_[1]->[0] == 0 ? 1 : 0;
+}
-sub _is_even
- {
- # return true if arg is even
- (!($_[1]->[0] & 1)) <=> 0;
- }
+sub _is_even {
+ # return true if arg is even
+ $_[1]->[0] & 1 ? 0 : 1;
+}
-sub _is_odd
- {
- # return true if arg is odd
- (($_[1]->[0] & 1)) <=> 0;
- }
+sub _is_odd {
+ # return true if arg is odd
+ $_[1]->[0] & 1 ? 1 : 0;
+}
-sub _is_one
- {
- # return true if arg is one
- (scalar @{$_[1]} == 1) && ($_[1]->[0] == 1) <=> 0;
- }
+sub _is_one {
+ # return true if arg is one
+ @{$_[1]} == 1 && $_[1]->[0] == 1 ? 1 : 0;
+}
-sub _is_two
- {
- # return true if arg is two
- (scalar @{$_[1]} == 1) && ($_[1]->[0] == 2) <=> 0;
- }
+sub _is_two {
+ # return true if arg is two
+ @{$_[1]} == 1 && $_[1]->[0] == 2 ? 1 : 0;
+}
-sub _is_ten
- {
- # return true if arg is ten
- (scalar @{$_[1]} == 1) && ($_[1]->[0] == 10) <=> 0;
- }
+sub _is_ten {
+ # return true if arg is ten
+ @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0;
+}
-sub __strip_zeros
- {
- # internal normalization function that strips leading zeros from the array
- # args: ref to array
- my $s = shift;
-
- my $cnt = scalar @$s; # get count of parts
- my $i = $cnt-1;
- push @$s,0 if $i < 0; # div might return empty results, so fix it
-
- return $s if @$s == 1; # early out
-
- #print "strip: cnt $cnt i $i\n";
- # '0', '3', '4', '0', '0',
- # 0 1 2 3 4
- # cnt = 5, i = 4
- # i = 4
- # i = 3
- # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
- # >= 1: skip first part (this can be zero)
- while ($i > 0) { last if $s->[$i] != 0; $i--; }
- $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
- $s;
- }
+sub __strip_zeros {
+ # Internal normalization function that strips leading zeros from the array.
+ # Args: ref to array
+ my $s = shift;
+
+ my $cnt = @$s; # get count of parts
+ my $i = $cnt - 1;
+ push @$s, 0 if $i < 0; # div might return empty results, so fix it
+
+ return $s if @$s == 1; # early out
+
+ #print "strip: cnt $cnt i $i\n";
+ # '0', '3', '4', '0', '0',
+ # 0 1 2 3 4
+ # cnt = 5, i = 4
+ # i = 4
+ # i = 3
+ # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
+ # >= 1: skip first part (this can be zero)
+ while ($i > 0) {
+ last if $s->[$i] != 0;
+ $i--;
+ }
+ $i++;
+ splice @$s, $i if $i < $cnt; # $i cant be 0
+ $s;
+}
###############################################################################
# check routine to test internal state for corruptions
-sub _check
- {
- # used by the test suite
- my $x = $_[1];
-
- return "$x is not a reference" if !ref($x);
-
- # are all parts are valid?
- my $i = 0; my $j = scalar @$x; my ($e,$try);
- while ($i < $j)
- {
- $e = $x->[$i]; $e = 'undef' unless defined $e;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)";
- last if $e !~ /^[+]?[0-9]+$/;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)";
- last if "$e" !~ /^[+]?[0-9]+$/;
- $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)";
- last if '' . "$e" !~ /^[+]?[0-9]+$/;
- $try = ' < 0 || >= $BASE; '."($x, $e)";
- last if $e <0 || $e >= $BASE;
- # this test is disabled, since new/bnorm and certain ops (like early out
- # in add/sub) are allowed/expected to leave '00000' in some elements
- #$try = '=~ /^00+/; '."($x, $e)";
- #last if $e =~ /^00+/;
- $i++;
- }
- return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
- 0;
- }
+sub _check {
+ # used by the test suite
+ my $x = $_[1];
+ return "$x is not a reference" if !ref($x);
+
+ # are all parts are valid?
+ my $i = 0;
+ my $j = @$x;
+ my ($e, $try);
+ while ($i < $j) {
+ $e = $x->[$i]; $e = 'undef' unless defined $e;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)";
+ last if $e !~ /^[+]?[0-9]+$/;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)";
+ last if "$e" !~ /^[+]?[0-9]+$/;
+ $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)";
+ last if '' . "$e" !~ /^[+]?[0-9]+$/;
+ $try = ' < 0 || >= $BASE; '."($x, $e)";
+ last if $e <0 || $e >= $BASE;
+ # This test is disabled, since new/bnorm and certain ops (like early out
+ # in add/sub) are allowed/expected to leave '00000' in some elements.
+ #$try = '=~ /^00+/; '."($x, $e)";
+ #last if $e =~ /^00+/;
+ $i++;
+ }
+ return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
+ 0;
+}
###############################################################################
-sub _mod
- {
- # if possible, use mod shortcut
- my ($c,$x,$yo) = @_;
+sub _mod {
+ # if possible, use mod shortcut
+ my ($c, $x, $yo) = @_;
- # slow way since $y too big
- if (scalar @$yo > 1)
- {
- my ($xo,$rem) = _div($c,$x,$yo);
- @$x = @$rem;
- return $x;
+ # slow way since $y too big
+ if (@$yo > 1) {
+ my ($xo, $rem) = _div($c, $x, $yo);
+ @$x = @$rem;
+ return $x;
}
- my $y = $yo->[0];
-
- # if both are single element arrays
- if (scalar @$x == 1)
- {
- $x->[0] %= $y;
- return $x;
- }
+ my $y = $yo->[0];
- # if @$x has more than one element, but @$y is a single element
- my $b = $BASE % $y;
- if ($b == 0)
- {
- # when BASE % Y == 0 then (B * BASE) % Y == 0
- # (B * BASE) % $y + A % Y => A % Y
- # so need to consider only last element: O(1)
- $x->[0] %= $y;
- }
- elsif ($b == 1)
- {
- # else need to go through all elements in @$x: O(N), but loop is a bit
- # simplified
- my $r = 0;
- foreach (@$x)
- {
- $r = ($r + $_) % $y; # not much faster, but heh...
- #$r += $_ % $y; $r %= $y;
- }
- $r = 0 if $r == $y;
- $x->[0] = $r;
+ # if both are single element arrays
+ if (scalar @$x == 1) {
+ $x->[0] %= $y;
+ return $x;
}
- else
- {
- # else need to go through all elements in @$x: O(N)
- my $r = 0;
- my $bm = 1;
- foreach (@$x)
- {
- $r = ($_ * $bm + $r) % $y;
- $bm = ($bm * $b) % $y;
- #$r += ($_ % $y) * $bm;
- #$bm *= $b;
- #$bm %= $y;
- #$r %= $y;
- }
- $r = 0 if $r == $y;
- $x->[0] = $r;
+ # if @$x has more than one element, but @$y is a single element
+ my $b = $BASE % $y;
+ if ($b == 0) {
+ # when BASE % Y == 0 then (B * BASE) % Y == 0
+ # (B * BASE) % $y + A % Y => A % Y
+ # so need to consider only last element: O(1)
+ $x->[0] %= $y;
+ } elsif ($b == 1) {
+ # else need to go through all elements in @$x: O(N), but loop is a bit
+ # simplified
+ my $r = 0;
+ foreach (@$x) {
+ $r = ($r + $_) % $y; # not much faster, but heh...
+ #$r += $_ % $y; $r %= $y;
+ }
+ $r = 0 if $r == $y;
+ $x->[0] = $r;
+ } else {
+ # else need to go through all elements in @$x: O(N)
+ my $r = 0;
+ my $bm = 1;
+ foreach (@$x) {
+ $r = ($_ * $bm + $r) % $y;
+ $bm = ($bm * $b) % $y;
+
+ #$r += ($_ % $y) * $bm;
+ #$bm *= $b;
+ #$bm %= $y;
+ #$r %= $y;
+ }
+ $r = 0 if $r == $y;
+ $x->[0] = $r;
}
- @$x = $x->[0]; # keep one element of @$x
- return $x;
- }
+ @$x = $x->[0]; # keep one element of @$x
+ return $x;
+}
##############################################################################
# shifts
-sub _rsft
- {
- my ($c,$x,$y,$n) = @_;
+sub _rsft {
+ my ($c, $x, $y, $n) = @_;
- if ($n != 10)
- {
- $n = _new($c,$n); return _div($c,$x, _pow($c,$n,$y));
+ if ($n != 10) {
+ $n = _new($c, $n);
+ return _div($c, $x, _pow($c, $n, $y));
}
- # shortcut (faster) for shifting by 10)
- # multiples of $BASE_LEN
- my $dst = 0; # destination
- my $src = _num($c,$y); # as normal int
- my $xlen = (@$x-1)*$BASE_LEN+length(int($x->[-1])); # len of x in digits
- if ($src >= $xlen or ($src == $xlen and ! defined $x->[1]))
- {
- # 12345 67890 shifted right by more than 10 digits => 0
- splice (@$x,1); # leave only one element
- $x->[0] = 0; # set to zero
- return $x;
- }
- my $rem = $src % $BASE_LEN; # remainder to shift
- $src = int($src / $BASE_LEN); # source
- if ($rem == 0)
- {
- splice (@$x,0,$src); # even faster, 38.4 => 39.3
+ # shortcut (faster) for shifting by 10)
+ # multiples of $BASE_LEN
+ my $dst = 0; # destination
+ my $src = _num($c, $y); # as normal int
+ my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1]));
+ if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) {
+ # 12345 67890 shifted right by more than 10 digits => 0
+ splice(@$x, 1); # leave only one element
+ $x->[0] = 0; # set to zero
+ return $x;
}
- else
- {
- my $len = scalar @$x - $src; # elems to go
- my $vd; my $z = '0'x $BASE_LEN;
- $x->[scalar @$x] = 0; # avoid || 0 test inside loop
- while ($dst < $len)
- {
- $vd = $z.$x->[$src];
- $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
- $src++;
- $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
- $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
- $x->[$dst] = int($vd);
- $dst++;
- }
- splice (@$x,$dst) if $dst > 0; # kill left-over array elems
- pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0
- } # else rem == 0
- $x;
- }
+ my $rem = $src % $BASE_LEN; # remainder to shift
+ $src = int($src / $BASE_LEN); # source
+ if ($rem == 0) {
+ splice(@$x, 0, $src); # even faster, 38.4 => 39.3
+ } else {
+ my $len = @$x - $src; # elems to go
+ my $vd;
+ my $z = '0' x $BASE_LEN;
+ $x->[@$x] = 0; # avoid || 0 test inside loop
+ while ($dst < $len) {
+ $vd = $z . $x->[$src];
+ $vd = substr($vd, -$BASE_LEN, $BASE_LEN - $rem);
+ $src++;
+ $vd = substr($z . $x->[$src], -$rem, $rem) . $vd;
+ $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
+ $x->[$dst] = int($vd);
+ $dst++;
+ }
+ splice(@$x, $dst) if $dst > 0; # kill left-over array elems
+ pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0
+ } # else rem == 0
+ $x;
+}
-sub _lsft
- {
- my ($c,$x,$y,$n) = @_;
-
- if ($n != 10)
- {
- $n = _new($c,$n); return _mul($c,$x, _pow($c,$n,$y));
- }
-
- # shortcut (faster) for shifting by 10) since we are in base 10eX
- # multiples of $BASE_LEN:
- my $src = scalar @$x; # source
- my $len = _num($c,$y); # shift-len as normal int
- my $rem = $len % $BASE_LEN; # remainder to shift
- my $dst = $src + int($len/$BASE_LEN); # destination
- my $vd; # further speedup
- $x->[$src] = 0; # avoid first ||0 for speed
- my $z = '0' x $BASE_LEN;
- while ($src >= 0)
- {
- $vd = $x->[$src]; $vd = $z.$vd;
- $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
- $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
- $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
- $x->[$dst] = int($vd);
- $dst--; $src--;
- }
- # set lowest parts to 0
- while ($dst >= 0) { $x->[$dst--] = 0; }
- # fix spurious last zero element
- splice @$x,-1 if $x->[-1] == 0;
- $x;
- }
+sub _lsft {
+ my ($c, $x, $y, $n) = @_;
+
+ if ($n != 10) {
+ $n = _new($c, $n);
+ return _mul($c, $x, _pow($c, $n, $y));
+ }
+
+ # shortcut (faster) for shifting by 10) since we are in base 10eX
+ # multiples of $BASE_LEN:
+ my $src = @$x; # source
+ my $len = _num($c, $y); # shift-len as normal int
+ my $rem = $len % $BASE_LEN; # remainder to shift
+ my $dst = $src + int($len / $BASE_LEN); # destination
+ my $vd; # further speedup
+ $x->[$src] = 0; # avoid first ||0 for speed
+ my $z = '0' x $BASE_LEN;
+ while ($src >= 0) {
+ $vd = $x->[$src];
+ $vd = $z . $vd;
+ $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem);
+ $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem)
+ : '0' x $rem;
+ $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
+ $x->[$dst] = int($vd);
+ $dst--;
+ $src--;
+ }
+ # set lowest parts to 0
+ while ($dst >= 0) {
+ $x->[$dst--] = 0;
+ }
+ # fix spurious last zero element
+ splice @$x, -1 if $x->[-1] == 0;
+ $x;
+}
-sub _pow
- {
- # power of $x to $y
- # ref to array, ref to array, return ref to array
- my ($c,$cx,$cy) = @_;
+sub _pow {
+ # power of $x to $y
+ # ref to array, ref to array, return ref to array
+ my ($c, $cx, $cy) = @_;
- if (scalar @$cy == 1 && $cy->[0] == 0)
- {
- splice (@$cx,1); $cx->[0] = 1; # y == 0 => x => 1
- return $cx;
+ if (@$cy == 1 && $cy->[0] == 0) {
+ splice(@$cx, 1);
+ $cx->[0] = 1; # y == 0 => x => 1
+ return $cx;
}
- if ((scalar @$cx == 1 && $cx->[0] == 1) || # x == 1
- (scalar @$cy == 1 && $cy->[0] == 1)) # or y == 1
+
+ if ((@$cx == 1 && $cx->[0] == 1) || # x == 1
+ (@$cy == 1 && $cy->[0] == 1)) # or y == 1
{
- return $cx;
+ return $cx;
}
- if (scalar @$cx == 1 && $cx->[0] == 0)
- {
- splice (@$cx,1); $cx->[0] = 0; # 0 ** y => 0 (if not y <= 0)
- return $cx;
+
+ if (@$cx == 1 && $cx->[0] == 0) {
+ splice (@$cx, 1);
+ $cx->[0] = 0; # 0 ** y => 0 (if not y <= 0)
+ return $cx;
}
- my $pow2 = _one();
+ my $pow2 = _one();
- my $y_bin = _as_bin($c,$cy); $y_bin =~ s/^0b//;
- my $len = length($y_bin);
- while (--$len > 0)
- {
- _mul($c,$pow2,$cx) if substr($y_bin,$len,1) eq '1'; # is odd?
- _mul($c,$cx,$cx);
+ my $y_bin = _as_bin($c, $cy);
+ $y_bin =~ s/^0b//;
+ my $len = length($y_bin);
+ while (--$len > 0) {
+ _mul($c, $pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd?
+ _mul($c, $cx, $cx);
}
- _mul($c,$cx,$pow2);
- $cx;
- }
+ _mul($c, $cx, $pow2);
+ $cx;
+}
sub _nok {
# Return binomial coefficient (n over k).
@@ -2293,7 +2273,7 @@ sub _as_oct
$es .= reverse sprintf("%05o", $xr->[0]);
}
$es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
+ $es =~ s/^0+//; # strip leading zeros
'0' . $es; # return result prepended with 0
}
diff --git a/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm b/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
index 973566f9f9..b5373e45c1 100644
--- a/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
+++ b/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
@@ -1,10 +1,11 @@
package Math::BigInt::CalcEmu;
-use 5.006002;
+use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999710';
+our $VERSION = '1.999714';
+$VERSION = eval $VERSION;
package Math::BigInt;
diff --git a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm
index 94d3f2a624..f35e26710c 100644
--- a/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm
+++ b/cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm
@@ -1,49 +1,49 @@
-#!/usr/bin/perl -w
+#!perl
# for testing subclassing Math::BigFloat
package Math::BigFloat::Subclass;
-require 5.005_02;
+require 5.006;
+
use strict;
+use warnings;
use Exporter;
-use Math::BigFloat(1.38);
-use vars qw($VERSION @ISA $PACKAGE
- $accuracy $precision $round_mode $div_scale);
+use Math::BigFloat 1.38;
+
+our ($accuracy, $precision, $round_mode, $div_scale);
-@ISA = qw(Exporter Math::BigFloat);
+our @ISA = qw(Exporter Math::BigFloat);
-$VERSION = 0.05;
+our $VERSION = "0.06";
-use overload; # inherit overload from BigInt
+use overload; # inherit overload from BigInt
# Globals
$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
-sub new
-{
- my $proto = shift;
- my $class = ref($proto) || $proto;
-
- my $value = shift;
- my $a = $accuracy; $a = $_[0] if defined $_[0];
- my $p = $precision; $p = $_[1] if defined $_[1];
- # Store the floating point value
- my $self = Math::BigFloat->new($value,$a,$p,$round_mode);
- bless $self, $class;
- $self->{'_custom'} = 1; # make sure this never goes away
- return $self;
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $value = shift;
+ my $a = $accuracy; $a = $_[0] if defined $_[0];
+ my $p = $precision; $p = $_[1] if defined $_[1];
+ # Store the floating point value
+ my $self = Math::BigFloat->new($value, $a, $p, $round_mode);
+ bless $self, $class;
+ $self->{'_custom'} = 1; # make sure this never goes away
+ return $self;
}
-BEGIN
- {
- *objectify = \&Math::BigInt::objectify;
- # to allow Math::BigFloat::Subclass::bgcd( ... ) style calls
- *bgcd = \&Math::BigFloat::bgcd;
- *blcm = \&Math::BigFloat::blcm;
- }
+BEGIN {
+ *objectify = \&Math::BigInt::objectify;
+ # to allow Math::BigFloat::Subclass::bgcd( ... ) style calls
+ *bgcd = \&Math::BigFloat::bgcd;
+ *blcm = \&Math::BigFloat::blcm;
+}
1;
diff --git a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm
index 0bbe861cf8..c0cec45a2d 100644
--- a/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm
+++ b/cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm
@@ -1,42 +1,43 @@
+#!perl
+
package Math::BigInt::BareCalc;
use 5.005;
use strict;
-# use warnings; # dont use warnings for older Perls
+use warnings;
require Exporter;
-use vars qw/@ISA $VERSION/;
-@ISA = qw(Exporter);
-$VERSION = '0.05';
+our @ISA = qw(Exporter);
+
+our $VERSION = '0.06';
sub api_version () { 1; }
# Package to to test Bigint's simulation of Calc
-# uses Calc, but only features the strictly necc. methods.
+# Uses Calc, but only features the strictly neccessary methods.
use Math::BigInt::Calc '0.51';
-BEGIN
- {
- no strict 'refs';
- foreach (qw/
- base_len new zero one two ten copy str num add sub mul div mod inc dec
- acmp alen len digit zeros
- rsft lsft
- fac pow gcd log_int sqrt root
- is_zero is_one is_odd is_even is_one is_two is_ten check
- as_hex as_bin as_oct from_hex from_bin from_oct
- modpow modinv
- and xor or
- /)
+BEGIN {
+ no strict 'refs';
+ foreach (qw/
+ base_len new zero one two ten copy str num add sub mul div mod inc dec
+ acmp alen len digit zeros
+ rsft lsft
+ fac pow gcd log_int sqrt root
+ is_zero is_one is_odd is_even is_one is_two is_ten check
+ as_hex as_bin as_oct from_hex from_bin from_oct
+ modpow modinv
+ and xor or
+ /)
{
- my $name = "Math::BigInt::Calc::_$_";
- *{"Math::BigInt::BareCalc::_$_"} = \&$name;
+ my $name = "Math::BigInt::Calc::_$_";
+ *{"Math::BigInt::BareCalc::_$_"} = \&$name;
}
- print "# BareCalc using Calc v$Math::BigInt::Calc::VERSION\n";
- }
+ print "# BareCalc using Calc v$Math::BigInt::Calc::VERSION\n";
+}
# catch and throw away
sub import { }
diff --git a/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm b/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm
index c20a3e377e..f6fa610682 100644
--- a/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm
+++ b/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm
@@ -4,77 +4,67 @@
package Math::BigInt::Scalar;
-use 5.005;
+use 5.006;
use strict;
-# use warnings; # dont use warnings for older Perls
+use warnings;
require Exporter;
-use vars qw/@ISA $VERSION/;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
-$VERSION = '0.13';
+our $VERSION = '0.13';
sub api_version() { 1; }
##############################################################################
# global constants, flags and accessory
-
+
# constants for easier life
my $nan = 'NaN';
##############################################################################
# create objects from various representations
-sub _new
- {
- # create scalar ref from string
- my $d = $_[1];
- my $x = $d; # make copy
- \$x;
- }
-
-sub _from_hex
- {
- # not used
- }
-
-sub _from_oct
- {
- # not used
- }
-
-sub _from_bin
- {
- # not used
- }
-
-sub _zero
- {
- my $x = 0; \$x;
- }
-
-sub _one
- {
- my $x = 1; \$x;
- }
-
-sub _two
- {
- my $x = 2; \$x;
- }
-
-sub _ten
- {
- my $x = 10; \$x;
- }
-
-sub _copy
- {
- my $x = $_[1];
- my $z = $$x;
- \$z;
- }
+sub _new {
+ # create scalar ref from string
+ my $d = $_[1];
+ my $x = $d; # make copy
+ \$x;
+}
+
+sub _from_hex {
+ # not used
+}
+
+sub _from_oct {
+ # not used
+}
+
+sub _from_bin {
+ # not used
+}
+
+sub _zero {
+ my $x = 0; \$x;
+}
+
+sub _one {
+ my $x = 1; \$x;
+}
+
+sub _two {
+ my $x = 2; \$x;
+}
+
+sub _ten {
+ my $x = 10; \$x;
+}
+
+sub _copy {
+ my $x = $_[1];
+ my $z = $$x;
+ \$z;
+}
# catch and throw away
sub import { }
@@ -82,247 +72,212 @@ sub import { }
##############################################################################
# convert back to string and number
-sub _str
- {
- # make string
- "${$_[1]}";
- }
-
-sub _num
- {
- # make a number
- 0+${$_[1]};
- }
-
-sub _zeros
- {
- my $x = $_[1];
-
- $x =~ /\d(0*)$/;
- length($1 || '');
- }
-
-sub _rsft
- {
- # not used
- }
-
-sub _lsft
- {
- # not used
- }
-
-sub _mod
- {
- # not used
- }
-
-sub _gcd
- {
- # not used
- }
-
-sub _sqrt
- {
- # not used
- }
-
-sub _root
- {
- # not used
- }
-
-sub _fac
- {
- # not used
- }
-
-sub _modinv
- {
- # not used
- }
-
-sub _modpow
- {
- # not used
- }
-
-sub _log_int
- {
- # not used
- }
-
-sub _as_hex
- {
- sprintf("0x%x",${$_[1]});
- }
-
-sub _as_bin
- {
- sprintf("0b%b",${$_[1]});
- }
-
-sub _as_oct
- {
- sprintf("0%o",${$_[1]});
- }
+sub _str {
+ # make string
+ "${$_[1]}";
+}
+
+sub _num {
+ # make a number
+ 0+${$_[1]};
+}
+
+sub _zeros {
+ my $x = $_[1];
+
+ $x =~ /\d(0*)$/;
+ length($1 || '');
+}
+
+sub _rsft {
+ # not used
+}
+
+sub _lsft {
+ # not used
+}
+
+sub _mod {
+ # not used
+}
+
+sub _gcd {
+ # not used
+}
+
+sub _sqrt {
+ # not used
+}
+
+sub _root {
+ # not used
+}
+
+sub _fac {
+ # not used
+}
+
+sub _modinv {
+ # not used
+}
+
+sub _modpow {
+ # not used
+}
+
+sub _log_int {
+ # not used
+}
+
+sub _as_hex {
+ sprintf("0x%x", ${$_[1]});
+}
+
+sub _as_bin {
+ sprintf("0b%b", ${$_[1]});
+}
+
+sub _as_oct {
+ sprintf("0%o", ${$_[1]});
+}
##############################################################################
# actual math code
-sub _add
- {
- my ($c,$x,$y) = @_;
- $$x += $$y;
- return $x;
- }
-
-sub _sub
- {
- my ($c,$x,$y) = @_;
- $$x -= $$y;
- return $x;
- }
-
-sub _mul
- {
- my ($c,$x,$y) = @_;
- $$x *= $$y;
- return $x;
- }
-
-sub _div
- {
- my ($c,$x,$y) = @_;
-
- my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u;
- return ($x,\$r) if wantarray;
- return $x;
- }
-
-sub _pow
- {
- my ($c,$x,$y) = @_;
- my $u = $$x ** $$y; $$x = $u;
- return $x;
- }
-
-sub _and
- {
- my ($c,$x,$y) = @_;
- my $u = int($$x) & int($$y); $$x = $u;
- return $x;
- }
-
-sub _xor
- {
- my ($c,$x,$y) = @_;
- my $u = int($$x) ^ int($$y); $$x = $u;
- return $x;
- }
-
-sub _or
- {
- my ($c,$x,$y) = @_;
- my $u = int($$x) | int($$y); $$x = $u;
- return $x;
- }
-
-sub _inc
- {
- my ($c,$x) = @_;
- my $u = int($$x)+1; $$x = $u;
- return $x;
- }
-
-sub _dec
- {
- my ($c,$x) = @_;
- my $u = int($$x)-1; $$x = $u;
- return $x;
- }
+sub _add {
+ my ($c, $x, $y) = @_;
+ $$x += $$y;
+ return $x;
+}
+
+sub _sub {
+ my ($c, $x, $y) = @_;
+ $$x -= $$y;
+ return $x;
+}
+
+sub _mul {
+ my ($c, $x, $y) = @_;
+ $$x *= $$y;
+ return $x;
+}
+
+sub _div {
+ my ($c, $x, $y) = @_;
+
+ my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u;
+ return ($x, \$r) if wantarray;
+ return $x;
+}
+
+sub _pow {
+ my ($c, $x, $y) = @_;
+ my $u = $$x ** $$y; $$x = $u;
+ return $x;
+}
+
+sub _and {
+ my ($c, $x, $y) = @_;
+ my $u = int($$x) & int($$y); $$x = $u;
+ return $x;
+}
+
+sub _xor {
+ my ($c, $x, $y) = @_;
+ my $u = int($$x) ^ int($$y); $$x = $u;
+ return $x;
+}
+
+sub _or {
+ my ($c, $x, $y) = @_;
+ my $u = int($$x) | int($$y); $$x = $u;
+ return $x;
+}
+
+sub _inc {
+ my ($c, $x) = @_;
+ my $u = int($$x)+1; $$x = $u;
+ return $x;
+}
+
+sub _dec {
+ my ($c, $x) = @_;
+ my $u = int($$x)-1; $$x = $u;
+ return $x;
+}
##############################################################################
# testing
-sub _acmp
- {
- my ($c,$x, $y) = @_;
- return ($$x <=> $$y);
- }
-
-sub _len
- {
- return length("${$_[1]}");
- }
-
-sub _digit
- {
- # return the nth digit, negative values count backward
- # 0 is the rightmost digit
- my ($c,$x,$n) = @_;
-
- $n ++; # 0 => 1, 1 => 2
- return substr($$x,-$n,1); # 1 => -1, -2 => 2 etc
- }
+sub _acmp {
+ my ($c, $x, $y) = @_;
+ return ($$x <=> $$y);
+}
+
+sub _len {
+ return length("${$_[1]}");
+}
+
+sub _digit {
+ # return the nth digit, negative values count backward
+ # 0 is the rightmost digit
+ my ($c, $x, $n) = @_;
+
+ $n ++; # 0 => 1, 1 => 2
+ return substr($$x, -$n, 1); # 1 => -1, -2 => 2 etc
+}
##############################################################################
# _is_* routines
-sub _is_zero
- {
- # return true if arg is zero
- my ($c,$x) = @_;
- ($$x == 0) <=> 0;
- }
-
-sub _is_even
- {
- # return true if arg is even
- my ($c,$x) = @_;
- (!($$x & 1)) <=> 0;
- }
-
-sub _is_odd
- {
- # return true if arg is odd
- my ($c,$x) = @_;
- ($$x & 1) <=> 0;
- }
-
-sub _is_one
- {
- # return true if arg is one
- my ($c,$x) = @_;
- ($$x == 1) <=> 0;
- }
-
-sub _is_two
- {
- # return true if arg is one
- my ($c,$x) = @_;
- ($$x == 2) <=> 0;
- }
-
-sub _is_ten
- {
- # return true if arg is one
- my ($c,$x) = @_;
- ($$x == 10) <=> 0;
- }
+sub _is_zero {
+ # return true if arg is zero
+ my ($c, $x) = @_;
+ ($$x == 0) <=> 0;
+}
+
+sub _is_even {
+ # return true if arg is even
+ my ($c, $x) = @_;
+ (!($$x & 1)) <=> 0;
+}
+
+sub _is_odd {
+ # return true if arg is odd
+ my ($c, $x) = @_;
+ ($$x & 1) <=> 0;
+}
+
+sub _is_one {
+ # return true if arg is one
+ my ($c, $x) = @_;
+ ($$x == 1) <=> 0;
+}
+
+sub _is_two {
+ # return true if arg is one
+ my ($c, $x) = @_;
+ ($$x == 2) <=> 0;
+}
+
+sub _is_ten {
+ # return true if arg is one
+ my ($c, $x) = @_;
+ ($$x == 10) <=> 0;
+}
###############################################################################
# check routine to test internal state of corruptions
-sub _check
- {
- # no checks yet, pull it out from the test suite
- my ($c,$x) = @_;
- return "$x is not a reference" if !ref($x);
- return 0;
- }
+sub _check {
+ # no checks yet, pull it out from the test suite
+ my ($c, $x) = @_;
+ return "$x is not a reference" if !ref($x);
+ return 0;
+}
1;
+
__END__
=head1 NAME
@@ -340,9 +295,9 @@ enough not to introduce bugs on it's own and to serve as a testbed.
Please see Math::BigInt::Calc.
=head1 LICENSE
-
+
This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
+the same terms as Perl itself.
=head1 AUTHOR
diff --git a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm
index d45e9e53ad..8876a83a08 100644
--- a/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm
+++ b/cpan/Math-BigInt/t/Math/BigInt/Subclass.pm
@@ -1,23 +1,25 @@
-#!/usr/bin/perl -w
+#!perl
package Math::BigInt::Subclass;
require 5.005_02;
+
use strict;
+use warnings;
use Exporter;
-use Math::BigInt (1.64);
+use Math::BigInt 1.64;
+
# $lib is for the "lib => " test
-use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK
- $lib
- $accuracy $precision $round_mode $div_scale);
+our $lib;
+our ($accuracy, $precision, $round_mode, $div_scale);
-@ISA = qw(Exporter Math::BigInt);
-@EXPORT_OK = qw(bgcd objectify);
+our @ISA = qw(Exporter Math::BigInt);
+our @EXPORT_OK = qw(bgcd objectify);
-$VERSION = 0.04;
+our $VERSION = "0.05";
-use overload; # inherit overload from BigInt
+use overload; # inherit overload from BigInt
# Globals
$accuracy = $precision = undef;
@@ -25,66 +27,64 @@ $round_mode = 'even';
$div_scale = 40;
$lib = '';
-sub new
-{
- my $proto = shift;
- my $class = ref($proto) || $proto;
-
- my $value = shift;
- my $a = $accuracy; $a = $_[0] if defined $_[0];
- my $p = $precision; $p = $_[1] if defined $_[1];
- my $self = Math::BigInt->new($value,$a,$p,$round_mode);
- bless $self,$class;
- $self->{'_custom'} = 1; # make sure this never goes away
- return $self;
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $value = shift;
+ my $a = $accuracy; $a = $_[0] if defined $_[0];
+ my $p = $precision; $p = $_[1] if defined $_[1];
+ my $self = Math::BigInt->new($value, $a, $p, $round_mode);
+ bless $self, $class;
+ $self->{'_custom'} = 1; # make sure this never goes away
+ return $self;
+}
+
+sub bgcd {
+ Math::BigInt::bgcd(@_);
+}
+
+sub blcm {
+ Math::BigInt::blcm(@_);
}
-sub bgcd
- {
- Math::BigInt::bgcd(@_);
- }
-
-sub blcm
- {
- Math::BigInt::blcm(@_);
- }
-
-sub as_int
- {
- Math::BigInt->new($_[0]);
- }
-
-BEGIN
- {
- *objectify = \&Math::BigInt::objectify;
-
- # these are called by AUTOLOAD from BigFloat, so we need at least these.
- # We cheat, of course..
- *bneg = \&Math::BigInt::bneg;
- *babs = \&Math::BigInt::babs;
- *bnan = \&Math::BigInt::bnan;
- *binf = \&Math::BigInt::binf;
- *bzero = \&Math::BigInt::bzero;
- *bone = \&Math::BigInt::bone;
- }
-
-sub import
- {
- my $self = shift;
-
- my @a; my $t = 0;
- foreach (@_)
- {
- # remove the "lib => foo" parameters and store it
- $lib = $_, $t = 0, next if $t == 1;
- if ($_ eq 'lib')
- {
- $t = 1; next;
- }
- push @a,$_;
+sub as_int {
+ Math::BigInt->new($_[0]);
+}
+
+BEGIN {
+ *objectify = \&Math::BigInt::objectify;
+
+ # these are called by AUTOLOAD from BigFloat, so we need at least these.
+ # We cheat, of course..
+ *bneg = \&Math::BigInt::bneg;
+ *babs = \&Math::BigInt::babs;
+ *bnan = \&Math::BigInt::bnan;
+ *binf = \&Math::BigInt::binf;
+ *bzero = \&Math::BigInt::bzero;
+ *bone = \&Math::BigInt::bone;
+}
+
+sub import {
+ my $self = shift;
+
+ my @a;
+ my $t = 0;
+ foreach (@_) {
+ # remove the "lib => foo" parameters and store it
+ if ($t == 1) {
+ $lib = $_;
+ $t = 0;
+ next;
+ }
+ if ($_ eq 'lib') {
+ $t = 1;
+ next;
+ }
+ push @a, $_;
}
- $self->SUPER::import(@a); # need it for subclasses
- $self->export_to_level(1,$self,@a); # need this ?
- }
+ $self->SUPER::import(@a); # need it for subclasses
+ $self->export_to_level(1, $self, @a); # need this ?
+}
1;
diff --git a/cpan/Math-BigInt/t/_e_math.t b/cpan/Math-BigInt/t/_e_math.t
index bae9e2df09..1c136a565e 100644
--- a/cpan/Math-BigInt/t/_e_math.t
+++ b/cpan/Math-BigInt/t/_e_math.t
@@ -1,8 +1,10 @@
-#!/usr/bin/perl -w
+#!perl
# test the helper math routines in Math::BigFloat
use strict;
+use warnings;
+
use Test::More tests => 26;
use Math::BigFloat lib => 'Calc';
@@ -10,76 +12,105 @@ use Math::BigFloat lib => 'Calc';
#############################################################################
# add
-my $a = Math::BigInt::Calc->_new("123");
-my $b = Math::BigInt::Calc->_new("321");
+{
+ my $a = Math::BigInt::Calc->_new("123");
+ my $b = Math::BigInt::Calc->_new("321");
+
+ test_add(123, 321, '+', '+');
+ test_add(123, 321, '+', '-');
+ test_add(123, 321, '-', '+');
+
+ test_add(321, 123, '-', '+');
+ test_add(321, 123, '+', '-');
-my ($x, $xs) = Math::BigFloat::_e_add($a,$b,'+','+');
-is (_str($x,$xs), '+444', 'add two positive numbers');
-is (_str($a,''), '444', 'a modified');
+ test_add(10, 1, '+', '-');
+ test_add(10, 1, '-', '+');
+ test_add( 1, 10, '-', '+');
-($x,$xs) = _add (123,321,'+','+');
-is (_str($x,$xs), '+444', 'add two positive numbers');
+ SKIP: {
+ skip q|$x -> _zero() does not (yet?) modify the first argument|, 2;
-($x,$xs) = _add (123,321,'+','-');
-is (_str($x,$xs), '-198', 'add +x + -y');
-($x,$xs) = _add (123,321,'-','+');
-is (_str($x,$xs), '+198', 'add -x + +y');
+ test_add(123, 123, '-', '+');
+ test_add(123, 123, '+', '-');
+ }
-($x,$xs) = _add (321,123,'-','+');
-is (_str($x,$xs), '-198', 'add -x + +y');
-($x,$xs) = _add (321,123,'+','-');
-is (_str($x,$xs), '+198', 'add +x + -y');
+ test_add(123, 123, '+', '+');
+ test_add(123, 123, '-', '-');
-($x,$xs) = _add (10,1,'+','-');
-is (_str($x,$xs), '+9', 'add 10 + -1');
-($x,$xs) = _add (10,1,'-','+');
-is (_str($x,$xs), '-9', 'add -10 + +1');
-($x,$xs) = _add (1,10,'-','+');
-is (_str($x,$xs), '+9', 'add -1 + 10');
-($x,$xs) = _add (1,10,'+','-');
-is (_str($x,$xs), '-9', 'add 1 + -10');
+ test_add(0, 0, '-', '+');
+ test_add(0, 0, '+', '-');
+ test_add(0, 0, '+', '+');
+ test_add(0, 0, '-', '-'); # gives "-0"! TODO: fix this!
+}
#############################################################################
# sub
-$a = Math::BigInt::Calc->_new("123");
-$b = Math::BigInt::Calc->_new("321");
-($x, $xs) = Math::BigFloat::_e_sub($b,$a,'+','+');
-is (_str($x,$xs), '+198', 'sub two positive numbers');
-is (_str($b,''), '198', 'a modified');
-
-($x,$xs) = _sub (123,321,'+','-');
-is (_str($x,$xs), '+444', 'sub +x + -y');
-($x,$xs) = _sub (123,321,'-','+');
-is (_str($x,$xs), '-444', 'sub -x + +y');
-
-sub _add
- {
- my ($a,$b,$as,$bs) = @_;
-
- my $aa = Math::BigInt::Calc->_new($a);
- my $bb = Math::BigInt::Calc->_new($b);
- my ($x, $xs) = Math::BigFloat::_e_add($aa,$bb,$as,$bs);
- is (Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa),
- 'param0 modified');
- ($x,$xs);
- }
-
-sub _sub
- {
- my ($a,$b,$as,$bs) = @_;
-
- my $aa = Math::BigInt::Calc->_new($a);
- my $bb = Math::BigInt::Calc->_new($b);
- my ($x, $xs) = Math::BigFloat::_e_sub($aa,$bb,$as,$bs);
- is (Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa),
- 'param0 modified');
- ($x,$xs);
- }
-
-sub _str
- {
- my ($x,$s) = @_;
-
- $s . Math::BigInt::Calc->_str($x);
- }
+{
+ my $a = Math::BigInt::Calc->_new("123");
+ my $b = Math::BigInt::Calc->_new("321");
+
+ test_sub(123, 321, '+', '-');
+ test_sub(123, 321, '-', '+');
+
+ test_sub(123, 123, '-', '+');
+ test_sub(123, 123, '+', '-');
+
+ SKIP: {
+ skip q|$x -> _zero() does not (yet?) modify the first argument|, 2;
+
+ test_sub(123, 123, '+', '+');
+ test_sub(123, 123, '-', '-');
+ }
+
+ test_sub(0, 0, '-', '+'); # gives "-0"! TODO: fix this!
+ test_sub(0, 0, '+', '-');
+ test_sub(0, 0, '+', '+');
+ test_sub(0, 0, '-', '-');
+}
+
+###############################################################################
+
+sub test_add {
+ my ($a, $b, $as, $bs) = @_;
+
+ my $aa = Math::BigInt::Calc -> _new($a);
+ my $bb = Math::BigInt::Calc -> _new($b);
+ my ($x, $xs) = Math::BigFloat::_e_add($aa, $bb, "$as", "$bs");
+ my $got = $xs . Math::BigInt::Calc->_str($x);
+
+ my $expected = sprintf("%+d", "$as$a" + "$bs$b");
+
+ subtest qq|Math::BigFloat::_e_add($a, $b, "$as", "$bs");|
+ => sub {
+ plan tests => 2;
+
+ is($got, $expected, 'output has the correct value');
+ is(Math::BigInt::Calc->_str($x),
+ Math::BigInt::Calc->_str($aa),
+ 'first operand to _e_add() is modified'
+ );
+ };
+}
+
+sub test_sub {
+ my ($a, $b, $as, $bs) = @_;
+
+ my $aa = Math::BigInt::Calc -> _new($a);
+ my $bb = Math::BigInt::Calc -> _new($b);
+ my ($x, $xs) = Math::BigFloat::_e_sub($aa, $bb, "$as", "$bs");
+ my $got = $xs . Math::BigInt::Calc->_str($x);
+
+ my $expected = sprintf("%+d", "$as$a" - "$bs$b");
+
+ subtest qq|Math::BigFloat::_e_sub($a, $b, "$as", "$bs");|
+ => sub {
+ plan tests => 2;
+
+ is($got, $expected, 'output has the correct value');
+ is(Math::BigInt::Calc->_str($x),
+ Math::BigInt::Calc->_str($aa),
+ 'first operand to _e_sub() is modified'
+ );
+ };
+}
diff --git a/cpan/Math-BigInt/t/alias.inc b/cpan/Math-BigInt/t/alias.inc
index 746a20c99e..3b381e18e2 100644
--- a/cpan/Math-BigInt/t/alias.inc
+++ b/cpan/Math-BigInt/t/alias.inc
@@ -1,12 +1,18 @@
+#!perl
-# alias subroutine testing, included by sub_ali.t and mbi_ali.t
+use strict;
+use warnings;
-my $x = $CL->new(123);
+our $CLASS;
-is ($x->is_pos(), 1, '123 is positive');
-is ($x->is_neg(), 0, '123 is not negative');
-is ($x->as_int(), 123, '123 is 123 as int');
-is (ref($x->as_int()), 'Math::BigInt', "as_int(123) is of class Math::BigInt");
+# alias subroutine testing, included by sub_ali.t, mbi_ali.t, and mbf_ali.t
+
+our $x = $CLASS->new(123);
+
+is($x->is_pos(), 1, "$CLASS -> new(123) -> is_pos()");
+is($x->is_neg(), 0, "$CLASS -> new(123) -> is_neg()");
+is($x->as_int(), 123, "$CLASS -> new(123) -> as_int()");
+is(ref($x->as_int()), 'Math::BigInt', "ref($CLASS -> new(123) -> as_int())");
$x->bneg();
-is ($x->is_pos(), 0, '-123 is not positive');
-is ($x->is_neg(), 1, '-123 is negative');
+is($x->is_pos(), 0, "$CLASS -> new(123) -> bneg() -> is_pos()");
+is($x->is_neg(), 1, "$CLASS -> new(123) -> bneg() -> is_neg()");
diff --git a/cpan/Math-BigInt/t/bare_mbf.t b/cpan/Math-BigInt/t/bare_mbf.t
index 28cd9fb8d7..38fdae3c95 100644
--- a/cpan/Math-BigInt/t/bare_mbf.t
+++ b/cpan/Math-BigInt/t/bare_mbf.t
@@ -1,14 +1,16 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 2363;
+use warnings;
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 2409;
+
+use lib 't';
use Math::BigFloat lib => 'BareCalc';
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigFloat";
-$CL = "Math::BigInt::BareCalc";
+our ($CLASS, $CALC);
+$CLASS = "Math::BigFloat";
+$CALC = "Math::BigInt::BareCalc"; # backend
-require 't/bigfltpm.inc'; # all tests here for sharing
+require 't/bigfltpm.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/bare_mbi.t b/cpan/Math-BigInt/t/bare_mbi.t
index bc221567c5..b87625d078 100644
--- a/cpan/Math-BigInt/t/bare_mbi.t
+++ b/cpan/Math-BigInt/t/bare_mbi.t
@@ -1,18 +1,18 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 3701;
+use warnings;
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 3724; # tests in require'd file
-use Math::BigInt lib => 'BareCalc';
+use lib 't';
-print "# ",Math::BigInt->config()->{lib},"\n";
+use Math::BigInt lib => 'BareCalc';
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigInt";
-$CL = "Math::BigInt::BareCalc";
+print "# ", Math::BigInt->config()->{lib}, "\n";
-my $version = '1.84'; # for $VERSION tests, match current release (by hand!)
+our ($CLASS, $CALC);
+$CLASS = "Math::BigInt";
+$CALC = "Math::BigInt::BareCalc"; # backend
-require 't/bigintpm.inc'; # perform same tests as bigintpm
+require 't/bigintpm.inc'; # perform same tests as bigintpm.t
diff --git a/cpan/Math-BigInt/t/bare_mif.t b/cpan/Math-BigInt/t/bare_mif.t
index 2e533241ea..89835bb8bc 100644
--- a/cpan/Math-BigInt/t/bare_mif.t
+++ b/cpan/Math-BigInt/t/bare_mif.t
@@ -1,24 +1,24 @@
-#!/usr/bin/perl -w
+#!perl
# test rounding, accuracy, precision and fallback, round_mode and mixing
-# of classes under BareCalc
+# of classes under Math::BigInt::BareCalc
use strict;
-use Test::More tests => 684
- + 1; # our own tests
+use warnings;
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 684 # tests in require'd file
+ + 1; # tests in this file
-print "# ",Math::BigInt->config()->{lib},"\n";
+use lib 't';
-use Math::BigInt lib => 'BareCalc';
+use Math::BigInt lib => 'BareCalc';
use Math::BigFloat lib => 'BareCalc';
-use vars qw/$mbi $mbf/;
-
+our ($mbi, $mbf);
$mbi = 'Math::BigInt';
$mbf = 'Math::BigFloat';
-is (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigInt->config()->{lib}');
require 't/mbimbf.inc';
diff --git a/cpan/Math-BigInt/t/big_pi_e.t b/cpan/Math-BigInt/t/big_pi_e.t
index 9cc4751aa4..f846a95d07 100644
--- a/cpan/Math-BigInt/t/big_pi_e.t
+++ b/cpan/Math-BigInt/t/big_pi_e.t
@@ -1,8 +1,10 @@
-#!/usr/bin/perl -w
+#!perl
# Test bpi() and bexp()
use strict;
+use warnings;
+
use Test::More tests => 8;
use Math::BigFloat;
@@ -11,23 +13,22 @@ use Math::BigFloat;
my $pi = Math::BigFloat::bpi();
-ok (!exists $pi->{_a}, 'A not set');
-ok (!exists $pi->{_p}, 'P not set');
+ok(!exists $pi->{_a}, 'A not set');
+ok(!exists $pi->{_p}, 'P not set');
$pi = Math::BigFloat->bpi();
-ok (!exists $pi->{_a}, 'A not set');
-ok (!exists $pi->{_p}, 'P not set');
+ok(!exists $pi->{_a}, 'A not set');
+ok(!exists $pi->{_p}, 'P not set');
$pi = Math::BigFloat->bpi(10);
-is ($pi->{_a}, 10, 'A set');
-is ($pi->{_p}, undef, 'P not set');
+is($pi->{_a}, 10, 'A set');
+is($pi->{_p}, undef, 'P not set');
#############################################################################
-my $e = Math::BigFloat->new(1)->bexp();
-
-ok (!exists $e->{_a}, 'A not set');
-ok (!exists $e->{_p}, 'P not set');
+my $e = Math::BigFloat->new(1)->bexp();
+ok(!exists $e->{_a}, 'A not set');
+ok(!exists $e->{_p}, 'P not set');
diff --git a/cpan/Math-BigInt/t/bigfltpm.inc b/cpan/Math-BigInt/t/bigfltpm.inc
index 158b3aa811..10d05137df 100644
--- a/cpan/Math-BigInt/t/bigfltpm.inc
+++ b/cpan/Math-BigInt/t/bigfltpm.inc
@@ -1,209 +1,193 @@
#include this file into another test for subclass testing...
-is ($class->config()->{lib},$CL);
-
use strict;
+use warnings;
+
+our ($CLASS, $CALC);
+
+is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}");
+
+my ($x, $y, $z, @args, $try, $want, $got);
+my ($f, $setup);
+
+while (<DATA>) {
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
-my $z;
-
-while (<DATA>)
- {
- $_ =~ s/[\n\r]//g; # remove newlines
- $_ =~ s/#.*$//; # remove comments
- $_ =~ s/\s+$//; # trailing spaces
- next if /^$/; # skip empty lines & comments
- if (s/^&//)
- {
- $f = $_;
+
+ if (s/^&//) {
+ $f = $_;
+ next;
+ }
+
+ if (/^\$/) {
+ $setup = $_;
+ $setup =~ s/\$/\$${CLASS}::/g; # round_mode, div_scale
+ #print "\$setup== $setup\n";
+ next;
}
- elsif (/^\$/)
- {
- $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale
- #print "\$setup== $setup\n";
+
+ if (m|^(.*?):(/.+)$|) {
+ $want = $2;
+ @args = split(/:/, $1, 99);
+ } else {
+ @args = split(/:/, $_, 99);
+ $want = pop(@args);
}
- else
- {
- if (m|^(.*?):(/.+)$|)
- {
- $ans = $2;
- @args = split(/:/,$1,99);
- }
- else
- {
- @args = split(/:/,$_,99); $ans = pop(@args);
- }
- $try = "\$x = $class->new(\"$args[0]\");";
- if ($f eq "bnorm")
- {
- $try .= "\$x;";
- } elsif ($f eq "binf") {
- $try .= "\$x->binf('$args[1]');";
- } elsif ($f eq "is_inf") {
- $try .= "\$x->is_inf('$args[1]');";
- } elsif ($f eq "bone") {
- $try .= "\$x->bone('$args[1]');";
- } elsif ($f eq "bstr") {
- $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
- $try .= '$x->bstr();';
- } elsif ($f eq "parts") {
+
+ $try = qq|\$x = $CLASS->new("$args[0]");|;
+ if ($f eq "bnorm") {
+ $try .= qq| \$x;|;
+ } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) {
+ $try .= qq| \$x->$f();|;
+ } 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]");|;
+ } elsif ($f eq "bstr") {
+ $try .= qq| \$x->accuracy($args[1]); \$x->precision($args[2]);|;
+ $try .= ' $x->bstr();';
+ # some unary ops
+ } elsif ($f =~ /^b(nan|sstr|neg|floor|ceil|int|abs)$/) {
+ $try .= qq| \$x->$f();|;
+ # overloaded functions
+ } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) {
+ $try .= qq| \$x = $f(\$x);|;
+ } elsif ($f eq "parts") {
# ->bstr() to see if an object is returned
- $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
- $try .= '"$a $b";';
- } elsif ($f eq "exponent") {
+ $try .= ' ($a, $b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
+ $try .= ' "$a $b";';
+ } elsif ($f eq "exponent") {
# ->bstr() to see if an object is returned
- $try .= '$x->exponent()->bstr();';
- } elsif ($f eq "mantissa") {
+ $try .= ' $x->exponent()->bstr();';
+ } elsif ($f eq "mantissa") {
# ->bstr() to see if an object is returned
- $try .= '$x->mantissa()->bstr();';
- } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) {
- $try .= "\$x->$f();";
- # some unary ops
- } elsif ($f =~ /^b(nan|sstr|neg|floor|ceil|int|abs)$/) {
- $try .= "\$x->$f();";
- # overloaded functions
- } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) {
- $try .= "\$x = $f(\$x);";
- # some is_xxx test function
- } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) {
- $try .= "\$x->$f();";
- } elsif ($f eq "bpi") {
- $try .= '$class->bpi($x);';
- } elsif ($f eq "binc") {
- $try .= '++$x;';
- } elsif ($f eq "bdec") {
- $try .= '--$x;';
- }elsif ($f eq "bround") {
- $try .= "$setup; \$x->bround($args[1]);";
- } elsif ($f eq "bfround") {
- $try .= "$setup; \$x->bfround($args[1]);";
- } elsif ($f eq "bsqrt") {
- $try .= "$setup; \$x->bsqrt();";
- } elsif ($f eq "bfac") {
- $try .= "$setup; \$x->bfac();";
- } elsif ($f eq "blog") {
- if (defined $args[1] && $args[1] ne '')
- {
- $try .= "\$y = $class->new($args[1]);";
- $try .= "$setup; \$x->blog(\$y);";
- }
- else
- {
- $try .= "$setup; \$x->blog();";
- }
- }
- else
- {
- $try .= "\$y = $class->new(\"$args[1]\");";
-
- if ($f eq "bgcd")
- {
- if (defined $args[2])
- {
- $try .= " \$z = $class->new(\"$args[2]\"); ";
- }
- $try .= "$class\::bgcd(\$x, \$y";
- $try .= ", \$z" if (defined $args[2]);
- $try .= " );";
+ $try .= ' $x->mantissa()->bstr();';
+ } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) {
+ $try .= qq| \$x->$f();|;
+ } elsif ($f eq "bpi") {
+ $try .= qq| $CLASS->bpi(\$x);|;
+ } elsif ($f eq "binc") {
+ $try .= ' ++$x;';
+ } elsif ($f eq "bdec") {
+ $try .= ' --$x;';
+ } elsif ($f eq "bround") {
+ $try .= qq| $setup; \$x->bround($args[1]);|;
+ } elsif ($f eq "bfround") {
+ $try .= qq| $setup; \$x->bfround($args[1]);|;
+ } elsif ($f eq "bsqrt") {
+ $try .= qq| $setup; \$x->bsqrt();|;
+ } elsif ($f eq "bfac") {
+ $try .= qq| $setup; \$x->bfac();|;
+ } elsif ($f eq "blog") {
+ if (defined $args[1] && $args[1] ne '') {
+ $try .= qq| \$y = $CLASS->new($args[1]);|;
+ $try .= qq| $setup; \$x->blog(\$y);|;
+ } else {
+ $try .= qq| $setup; \$x->blog();|;
+ }
+ } else {
+ # binary operators
+ $try .= qq| \$y = $CLASS->new("$args[1]");|;
+
+ if ($f eq "bgcd") {
+ if (defined $args[2]) {
+ $try .= qq| \$z = $CLASS->new("$args[2]");|;
+ }
+ $try .= qq| $CLASS\::bgcd(\$x, \$y|;
+ $try .= qq|, \$z| if defined $args[2];
+ $try .= qq|);|;
+ } elsif ($f eq "blcm") {
+ if (defined $args[2]) {
+ $try .= qq| \$z = $CLASS->new("$args[2]");|;
+ }
+ $try .= qq| $CLASS\::blcm(\$x, \$y|;
+ $try .= qq|, \$z| if defined $args[2];
+ $try .= qq|);|;
+ } elsif ($f eq "bcmp") {
+ $try .= ' $x->bcmp($y);';
+ } elsif ($f eq "bacmp") {
+ $try .= ' $x->bacmp($y);';
+ } elsif ($f eq "bpow") {
+ $try .= ' $x ** $y;';
+ } elsif ($f eq "bnok") {
+ $try .= ' $x->bnok($y);';
+ } elsif ($f eq "bcos") {
+ $try .= ' $x->bcos($y);';
+ } elsif ($f eq "bsin") {
+ $try .= ' $x->bsin($y);';
+ } elsif ($f eq "batan") {
+ $try .= ' $x->batan($y);';
+ } elsif ($f eq "broot") {
+ $try .= qq| $setup; \$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 .= qq| $setup; \$x / \$y;|;
+ } elsif ($f eq "bdiv-list") {
+ $try .= qq| $setup; join(",", \$x->bdiv(\$y));|;
+ } elsif ($f eq "brsft") {
+ $try .= ' $x >> $y;';
+ } elsif ($f eq "blsft") {
+ $try .= ' $x << $y;';
+ } elsif ($f eq "bmod") {
+ $try .= ' $x % $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);';
+ } elsif ($f eq "batan2") {
+ $try .= ' $x->batan2($y, $z);';
+ } else {
+ warn qq|Unknown op "$f"|;
+ }
}
- elsif ($f eq "blcm")
- {
- if (defined $args[2])
- {
- $try .= " \$z = $class->new(\"$args[2]\"); ";
- }
- $try .= "$class\::blcm(\$x, \$y";
- $try .= ", \$z" if (defined $args[2]);
- $try .= " );";
- } elsif ($f eq "bcmp") {
- $try .= '$x->bcmp($y);';
- } elsif ($f eq "bacmp") {
- $try .= '$x->bacmp($y);';
- } elsif ($f eq "bpow") {
- $try .= '$x ** $y;';
- } elsif ($f eq "bnok") {
- $try .= '$x->bnok($y);';
- } elsif ($f eq "bcos") {
- $try .= '$x->bcos($y);';
- } elsif ($f eq "bsin") {
- $try .= '$x->bsin($y);';
- } elsif ($f eq "batan") {
- $try .= '$x->batan($y);';
- } elsif ($f eq "broot") {
- $try .= "$setup; \$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 .= "$setup; \$x / \$y;";
- } elsif ($f eq "bdiv-list") {
- $try .= "$setup; join(',',\$x->bdiv(\$y));";
- } elsif ($f eq "brsft") {
- $try .= '$x >> $y;';
- } elsif ($f eq "blsft") {
- $try .= '$x << $y;';
- } elsif ($f eq "bmod") {
- $try .= '$x % $y;';
- } else {
- # Functions with three arguments
- $try .= "\$z = $class->new(\"$args[2]\");";
-
- if( $f eq "bmodpow") {
- $try .= '$x->bmodpow($y,$z);';
- } elsif ($f eq "bmuladd"){
- $try .= '$x->bmuladd($y,$z);';
- } elsif ($f eq "batan2"){
- $try .= '$x->batan2($y,$z);';
- } else { warn "Unknown op '$f'"; }
- }
}
- # print "# Trying: '$try'\n";
- $ans1 = eval $try;
+
+ $got = eval $try;
print "# Error: $@\n" if $@;
- if ($ans =~ m|^/(.*)$|)
- {
- my $pat = $1;
- if ($ans1 =~ /$pat/)
- {
- is (1,1);
- }
- else
- {
- print "# '$try' expected: /$pat/ got: '$ans1'\n" if !is (1,0);
- }
- }
- else
- {
- if ($ans eq "")
- {
- is ($ans1, undef);
- }
- else
- {
- print "# Tried: '$try'\n" if !is ($ans1, $ans);
- if (ref($ans1) eq "$class")
- {
- # float numbers are normalized (for now), so mantissa shouldn't have
- # trailing zeros
- #print $ans1->_trailing_zeros(),"\n";
- print "# Has trailing zeros after '$try'\n"
- if !is ($CL->_zeros( $ans1->{_m}), 0);
- }
+
+ if ($want =~ m|^/(.*)$|) {
+ my $pat = $1;
+ like($got, qr/$pat/, $try);
+ } else {
+ if ($want eq "") {
+ is($got, undef, $try);
+ } else {
+ is($got, $want, $try);
+ if (ref($got) eq $CLASS) {
+ # float numbers are normalized (for now), so mantissa shouldn't
+ # have trailing zeros print $got->_trailing_zeros(), "\n";
+ is($CALC->_zeros($got->{_m}), 0, $try);
+ }
}
- } # end pattern or string
- }
- } # end while
+ } # end pattern or string
-# check whether $class->new( Math::BigInt->new()) destroys it
+} # end while
+
+# check whether $CLASS->new(Math::BigInt->new()) destroys it
# ($y == 12 in this case)
-$x = Math::BigInt->new(1200); $y = $class->new($x);
-is ($y,1200); is ($x,1200);
+$x = Math::BigInt->new(1200);
+$y = $CLASS->new($x);
+is($y, 1200,
+ q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $y|);
+is($x, 1200,
+ q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $x|);
###############################################################################
-# Really huge, big, ultra-mega-biggy-monster exponents
-# Technically, the exponents should not be limited (they are BigInts), but
+# Really huge, big, ultra-mega-biggy-monster exponents. Technically, the
+# exponents should not be limited (they are Math::BigInt objects), but
# practically there are a few places were they are limited to a Perl scalar.
# This is sometimes for speed, sometimes because otherwise the number wouldn't
# fit into your memory (just think of 1e123456789012345678901234567890 + 1!)
@@ -213,60 +197,91 @@ is ($y,1200); is ($x,1200);
my $monster = '1e1234567890123456789012345678901234567890';
# new and exponent
-is ($class->new($monster)->bsstr(),
- '1e+1234567890123456789012345678901234567890');
-is ($class->new($monster)->exponent(),
- '1234567890123456789012345678901234567890');
+is($CLASS->new($monster)->bsstr(),
+ '1e+1234567890123456789012345678901234567890',
+ qq|$CLASS->new("$monster")->bsstr()|);
+is($CLASS->new($monster)->exponent(),
+ '1234567890123456789012345678901234567890',
+ qq|$CLASS->new("$monster")->exponent()|);
+
# cmp
-is ($class->new($monster) > 0,1);
+is($CLASS->new($monster) > 0, 1, qq|$CLASS->new("$monster") > 0|);
-# sub/mul
-is ($class->new($monster)->bsub( $monster),0);
-is ($class->new($monster)->bmul(2)->bsstr(),
- '2e+1234567890123456789012345678901234567890');
+# sub/mul
+is($CLASS->new($monster)->bsub($monster), 0,
+ qq|$CLASS->new("$monster")->bsub("$monster")|);
+is($CLASS->new($monster)->bmul(2)->bsstr(),
+ '2e+1234567890123456789012345678901234567890',
+ qq|$CLASS->new("$monster")->bmul(2)->bsstr()|);
# mantissa
$monster = '1234567890123456789012345678901234567890e2';
-is ($class->new($monster)->mantissa(),
- '123456789012345678901234567890123456789');
+is($CLASS->new($monster)->mantissa(),
+ '123456789012345678901234567890123456789',
+ qq|$CLASS->new("$monster")->mantissa()|);
###############################################################################
-# zero,inf,one,nan
+# zero, inf, one, nan
-$x = $class->new(2); $x->bzero(); is ($x->{_a}, undef); is ($x->{_p}, undef);
-$x = $class->new(2); $x->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef);
-$x = $class->new(2); $x->bone(); is ($x->{_a}, undef); is ($x->{_p}, undef);
-$x = $class->new(2); $x->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef);
+$x = $CLASS->new(2);
+$x->bzero();
+is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bzero(); \$x->{_a}|);
+is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bzero(); \$x->{_p}|);
+
+$x = $CLASS->new(2);
+$x->binf();
+is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->binf(); \$x->{_a}|);
+is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->binf(); \$x->{_p}|);
+
+$x = $CLASS->new(2);
+$x->bone();
+is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bone(); \$x->{_a}|);
+is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bone(); \$x->{_p}|);
+
+$x = $CLASS->new(2);
+$x->bnan();
+is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bnan(); \$x->{_a}|);
+is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bnan(); \$x->{_p}|);
###############################################################################
# bone/binf etc as plain calls (Lite failed them)
-is ($class->bzero(),0);
-is ($class->bone(),1);
-is ($class->bone('+'),1);
-is ($class->bone('-'),-1);
-is ($class->bnan(),'NaN');
-is ($class->binf(),'inf');
-is ($class->binf('+'),'inf');
-is ($class->binf('-'),'-inf');
-is ($class->binf('-inf'),'-inf');
-
-$class->accuracy(undef); $class->precision(undef); # reset
+is($CLASS->bzero(), 0, qq|$CLASS->bzero()|);
+is($CLASS->bone(), 1, qq|$CLASS->bone()|);
+is($CLASS->bone("+"), 1, qq|$CLASS->bone("+")|);
+is($CLASS->bone("-"), -1, qq|$CLASS->bone("-")|);
+is($CLASS->bnan(), "NaN", qq|$CLASS->bnan()|);
+is($CLASS->binf(), "inf", qq|$CLASS->binf()|);
+is($CLASS->binf("+"), "inf", qq|$CLASS->binf("+")|);
+is($CLASS->binf("-"), "-inf", qq|$CLASS->binf("-")|);
+is($CLASS->binf("-inf"), "-inf", qq|$CLASS->binf("-inf")|);
+
+$CLASS->accuracy(undef); # reset
+$CLASS->precision(undef); # reset
###############################################################################
# bug in bsstr()/numify() showed up in after-rounding in bdiv()
-$x = $class->new('0.008'); $y = $class->new(2);
-$x->bdiv(3,$y);
-is ($x,'0.0027');
+$x = $CLASS->new("0.008");
+$y = $CLASS->new(2);
+$x->bdiv(3, $y);
+is($x, "0.0027",
+ qq|\$x = $CLASS->new("0.008"); \$y = $CLASS->new(2); \$x->bdiv(3, \$y);|);
###############################################################################
# Verify that numify() returns a normalized value, and underflows and
# overflows when given "extreme" values.
-like($class->new("12345e67")->numify(), qr/^1\.2345e\+?0*71$/);
-like($class->new("1e-9999")->numify(), qr/^\+?0$/); # underflow
-unlike($class->new("1e9999")->numify(), qr/^1(\.0*)?e\+?9+$/); # overflow
+like($CLASS->new("12345e67")->numify(), qr/^1\.2345e\+?0*71$/,
+ qq|$CLASS->new("12345e67")->numify()|);
+
+# underflow
+like($CLASS->new("1e-9999")->numify(), qr/^\+?0$/,
+ qq|$CLASS->new("1e-9999")->numify()|);
+
+# overflow
+unlike($CLASS->new("1e9999")->numify(), qr/^1(\.0*)?e\+?9+$/,
+ qq|$CLASS->new("1e9999")->numify()|);
###############################################################################
# Check numify on non-finite objects.
@@ -275,82 +290,161 @@ unlike($class->new("1e9999")->numify(), qr/^1(\.0*)?e\+?9+$/); # overflow
require Math::Complex;
my $inf = Math::Complex::Inf();
my $nan = $inf - $inf;
- is($class -> binf("+") -> numify(), $inf, "numify of +Inf");
- is($class -> binf("-") -> numify(), -$inf, "numify of -Inf");
- is($class -> bnan() -> numify(), $nan, "numify of NaN");
+ is($CLASS -> binf("+") -> numify(), $inf, "numify of +Inf");
+ is($CLASS -> binf("-") -> numify(), -$inf, "numify of -Inf");
+ is($CLASS -> bnan() -> numify(), $nan, "numify of NaN");
}
###############################################################################
# bsqrt() with set global A/P or A/P enabled on $x, also a test whether bsqrt()
# correctly modifies $x
+$x = $CLASS->new(12);
+$CLASS->precision(-2);
+$x->bsqrt();
+is($x, '3.46',
+ qq|\$x = $CLASS->new(12); $CLASS->precision(-2); \$x->bsqrt();|);
-$x = $class->new(12); $class->precision(-2); $x->bsqrt(); is ($x,'3.46');
+$CLASS->precision(undef);
+$x = $CLASS->new(12);
+$CLASS->precision(0);
+$x->bsqrt();
+is($x, '3',
+ qq|$CLASS->precision(undef); \$x = $CLASS->new(12);| .
+ qq| $CLASS->precision(0); \$x->bsqrt();|);
-$class->precision(undef);
-$x = $class->new(12); $class->precision(0); $x->bsqrt(); is ($x,'3');
-
-$class->precision(-3); $x = $class->new(12); $x->bsqrt(); is ($x,'3.464');
+$CLASS->precision(-3);
+$x = $CLASS->new(12);
+$x->bsqrt();
+is($x, '3.464',
+ qq|$CLASS->precision(-3); \$x = $CLASS->new(12); \$x->bsqrt();|);
{
- no strict 'refs';
- # A and P set => NaN
- ${${class}.'::accuracy'} = 4; $x = $class->new(12);
- $x->bsqrt(3); is ($x,'NaN');
- # supplied arg overrides set global
- $class->precision(undef); $x = $class->new(12); $x->bsqrt(3); is ($x,'3.46');
- $class->accuracy(undef); $class->precision(undef); # reset for further tests
+ no strict 'refs';
+ # A and P set => NaN
+ ${${CLASS}.'::accuracy'} = 4;
+ $x = $CLASS->new(12);
+ $x->bsqrt(3);
+ is($x, 'NaN', "A and P set => NaN");
+
+ # supplied arg overrides set global
+ $CLASS->precision(undef);
+ $x = $CLASS->new(12);
+ $x->bsqrt(3);
+ is($x, '3.46', "supplied arg overrides set global");
+
+ # reset for further tests
+ $CLASS->accuracy(undef);
+ $CLASS->precision(undef);
}
#############################################################################
# can we call objectify (broken until v1.52)
{
- no strict;
- $try =
- '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);';
- $ans = eval $try;
- is ($ans,"$class 4 5");
+ no strict;
+ $try = '@args'
+ . " = $CLASS"
+ . "::objectify(2, $CLASS, 4, 5);"
+ . ' join(" ", @args);';
+ $want = eval $try;
+ is($want, "$CLASS 4 5", $try);
}
#############################################################################
# is_one('-') (broken until v1.64)
-is ($class->new(-1)->is_one(),0);
-is ($class->new(-1)->is_one('-'),1);
+is($CLASS->new(-1)->is_one(), 0, qq|$CLASS->new(-1)->is_one()|);
+is($CLASS->new(-1)->is_one("-"), 1, qq|$CLASS->new(-1)->is_one("-")|);
#############################################################################
# bug 1/0.5 leaving 2e-0 instead of 2e0
-is ($class->new(1)->bdiv('0.5')->bsstr(),'2e+0');
+is($CLASS->new(1)->bdiv("0.5")->bsstr(), "2e+0",
+ qq|$CLASS->new(1)->bdiv("0.5")->bsstr()|);
###############################################################################
# [perl #30609] bug with $x -= $x not being 0, but 2*$x
-$x = $class->new(3); $x -= $x; is ($x, 0);
-$x = $class->new(-3); $x -= $x; is ($x, 0);
-$x = $class->new(3); $x += $x; is ($x, 6);
-$x = $class->new(-3); $x += $x; is ($x, -6);
+$x = $CLASS->new(3);
+$x -= $x;
+is($x, 0, qq|\$x = $CLASS->new(3); \$x -= \$x;|);
+
+$x = $CLASS->new(-3);
+$x -= $x;
+is($x, 0, qq|\$x = $CLASS->new(-3); \$x -= \$x;|);
+
+$x = $CLASS->new(3);
+$x += $x;
+is($x, 6, qq|\$x = $CLASS->new(3); \$x += \$x;|);
+
+$x = $CLASS->new(-3);
+$x += $x;
+is($x, -6, qq|\$x = $CLASS->new(-3); \$x += \$x;|);
-$x = $class->new('NaN'); $x -= $x; is ($x->is_nan(), 1);
-$x = $class->new('inf'); $x -= $x; is ($x->is_nan(), 1);
-$x = $class->new('-inf'); $x -= $x; is ($x->is_nan(), 1);
+$x = $CLASS->new("NaN");
+$x -= $x;
+is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x -= \$x;|);
-$x = $class->new('NaN'); $x += $x; is ($x->is_nan(), 1);
-$x = $class->new('inf'); $x += $x; is ($x->is_inf(), 1);
-$x = $class->new('-inf'); $x += $x; is ($x->is_inf('-'), 1);
+$x = $CLASS->new("inf");
+$x -= $x;
+is($x->is_nan(), 1, qq|\$x = $CLASS->new("inf"); \$x -= \$x;|);
-$x = $class->new('3.14'); $x -= $x; is ($x, 0);
-$x = $class->new('-3.14'); $x -= $x; is ($x, 0);
-$x = $class->new('3.14'); $x += $x; is ($x, '6.28');
-$x = $class->new('-3.14'); $x += $x; is ($x, '-6.28');
+$x = $CLASS->new("-inf");
+$x -= $x;
+is($x->is_nan(), 1, qq|\$x = $CLASS->new("-inf"); \$x -= \$x;|);
-$x = $class->new('3.14'); $x *= $x; is ($x, '9.8596');
-$x = $class->new('-3.14'); $x *= $x; is ($x, '9.8596');
-$x = $class->new('3.14'); $x /= $x; is ($x, '1');
-$x = $class->new('-3.14'); $x /= $x; is ($x, '1');
-$x = $class->new('3.14'); $x %= $x; is ($x, '0');
-$x = $class->new('-3.14'); $x %= $x; is ($x, '0');
+$x = $CLASS->new("NaN");
+$x += $x;
+is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x += \$x;|);
+
+$x = $CLASS->new("inf");
+$x += $x;
+is($x->is_inf(), 1, qq|\$x = $CLASS->new("inf"); \$x += \$x;|);
+
+$x = $CLASS->new("-inf");
+$x += $x;
+is($x->is_inf("-"), 1, qq|\$x = $CLASS->new("-inf"); \$x += \$x;|);
+
+$x = $CLASS->new("3.14");
+$x -= $x;
+is($x, 0, qq|\$x = $CLASS->new("3.14"); \$x -= \$x;|);
+
+$x = $CLASS->new("-3.14");
+$x -= $x;
+is($x, 0, qq|\$x = $CLASS->new("-3.14"); \$x -= \$x;|);
+
+$x = $CLASS->new("3.14");
+$x += $x;
+is($x, "6.28", qq|$x = $CLASS->new("3.14"); $x += $x;|);
+
+$x = $CLASS->new("-3.14");
+$x += $x;
+is($x, "-6.28", qq|$x = $CLASS->new("-3.14"); $x += $x;|);
+
+$x = $CLASS->new("3.14");
+$x *= $x;
+is($x, "9.8596", qq|$x = $CLASS->new("3.14"); $x *= $x;|);
+
+$x = $CLASS->new("-3.14");
+$x *= $x;
+is($x, "9.8596", qq|$x = $CLASS->new("-3.14"); $x *= $x;|);
+
+$x = $CLASS->new("3.14");
+$x /= $x;
+is($x, "1", qq|$x = $CLASS->new("3.14"); $x /= $x;|);
+
+$x = $CLASS->new("-3.14");
+$x /= $x;
+is($x, "1", qq|$x = $CLASS->new("-3.14"); $x /= $x;|);
+
+$x = $CLASS->new("3.14");
+$x %= $x;
+is($x, "0", qq|$x = $CLASS->new("3.14"); $x %= $x;|);
+
+$x = $CLASS->new("-3.14");
+$x %= $x;
+is($x, "0", qq|$x = $CLASS->new("-3.14"); $x %= $x;|);
###############################################################################
# the following two were reported by "kenny" via hotmail.com:
@@ -358,41 +452,67 @@ $x = $class->new('-3.14'); $x %= $x; is ($x, '0');
#perl -MMath::BigFloat -wle 'print Math::BigFloat->new(0)->bpow(".1")'
#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851.
-$x = $class->new(0); $y = $class->new('0.1');
-is ($x ** $y, 0, 'no warnings and zero result');
+$x = $CLASS->new(0);
+$y = $CLASS->new("0.1");
+is($x ** $y, 0,
+ qq|\$x = $CLASS->new(0); \$y = $CLASS->new("0.1"); \$x ** \$y|);
#perl -MMath::BigFloat -lwe 'print Math::BigFloat->new(".222222222222222222222222222222222222222222")->bceil()'
#Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851.
-$x = $class->new(".222222222222222222222222222222222222222222");
-is ($x->bceil(), 1, 'no warnings and one as result');
+$x = $CLASS->new(".222222222222222222222222222222222222222222");
+is($x->bceil(), 1,
+ qq|$x = $CLASS->new(".222222222222222222222222222222222222222222");| .
+ qq| $x->bceil();|);
###############################################################################
# test **=, <<=, >>=
-# ((2^148)-1)/17
-$x = $class->new(2); $x **= 148; $x++; $x->bdiv(17, 60)->bfloor(); $x->accuracy(undef);
-is ($x,"20988936657440586486151264256610222593863921");
-is ($x->length(),length "20988936657440586486151264256610222593863921");
+# ((2**148)+1)/17
+$x = $CLASS->new(2);
+$x **= 148;
+$x++;
+$x->bdiv(17, 60)->bfloor();
+$x->accuracy(undef);
+is($x, "20988936657440586486151264256610222593863921",
+ "value of ((2**148)+1)/17");
+is($x->length(), length("20988936657440586486151264256610222593863921"),
+ "number of digits in ((2**148)+1)/17");
-$x = $class->new('2');
-my $y = $class->new('18');
-is ($x <<= $y, 2 << 18);
-is ($x, 2 << 18);
-is ($x >>= $y, 2);
-is ($x, 2);
+$x = $CLASS->new("2");
+$y = $CLASS->new("18");
+is($x <<= $y, 2 << 18,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");|
+ . q| $x <<= $y|);
+is($x, 2 << 18,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");|
+ . q| $x <<= $y; $x|);
+is($x >>= $y, 2,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");|
+ . q| $x <<= $y; $x >>= $y|);
+is($x, 2,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");|
+ . q| $x <<= $y; $x >>= $y; $x|);
-$x = $class->new('2');
-$y = $class->new('18.2');
-$x <<= $y; # 2 * (2 ** 18.2);
+$x = $CLASS->new("2");
+$y = $CLASS->new("18.2");
-is ($x->copy()->bfround(-9), '602248.763144685');
-is ($x >>= $y, 2); # 2 * (2 ** 18.2) / (2 ** 18.2) => 2
-is ($x, 2);
+# 2 * (2 ** 18.2);
+$x <<= $y;
+is($x->copy()->bfround(-9), "602248.763144685",
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| .
+ q| $x <<= $y; $x->copy()->bfround(-9);|);
-1; # all done
+# 2 * (2 ** 18.2) / (2 ** 18.2) => 2
+is($x >>= $y, 2,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| .
+ q| $x <<= $y; $x->copy()->bfround(-9); $x >>= $y|);
+is($x, 2,
+ qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| .
+ q| $x <<= $y; $x->copy()->bfround(-9); $x >>= $y; $x|);
__DATA__
+
&bgcd
inf:12:NaN
-inf:12:NaN
@@ -420,6 +540,7 @@ abc:+0:NaN
1034:804:2
27:90:56:1
27:90:54:9
+
&blcm
abc:abc:NaN
abc:+0:NaN
@@ -429,7 +550,8 @@ abc:+0:NaN
+0:+1:0
+27:+90:270
+1034:+804:415668
-$div_scale = 40;
+$div_scale = 40
+
&bcos
1.2:10:0.3623577545
2.4:12:-0.737393715541
@@ -437,6 +559,7 @@ $div_scale = 40;
0:20:1
1:10:0.5403023059
1:12:0.540302305868
+
&bsin
1:10:0.8414709848
0:10:0
@@ -445,37 +568,67 @@ $div_scale = 40;
1.2:13:0.9320390859672
0.2:13:0.1986693307951
3.2:12:-0.0583741434276
+
&batan
NaN:10:NaN
inf:14:1.5707963267949
-inf:14:-1.5707963267949
+0:14:0
+0:10:0
+0.1:14:0.099668652491162
0.2:13:0.1973955598499
0.2:14:0.19739555984988
-0:10:0
+0.5:14:0.46364760900081
1:14:0.78539816339744
-1:14:-0.78539816339744
-# test an argument X > 1
-2:14:1.1071487177941
+1.5:14:0.98279372324732
+2.0:14:1.1071487177941
+2.5:14:1.1902899496825
+3.0:14:1.2490457723982
+6.0:14:1.4056476493803
+12:14:1.4876550949064
+24:14:1.5291537476963
+48:14:1.5499660067587
+
&batan2
+
NaN:1:10:NaN
NaN:NaN:10:NaN
1:NaN:10:NaN
-inf:1:14:1.5707963267949
--inf:1:14:-1.5707963267949
-0:-inf:14:3.1415926535898
--1:-inf:14:-3.1415926535898
-1:-inf:14:3.1415926535898
-0:inf:14:0
-inf:-inf:14:2.3561944901923
+
-inf:-inf:14:-2.3561944901923
-inf:+inf:14:0.7853981633974
--inf:+inf:14:-0.7853981633974
+-inf:-1:14:-1.5707963267949
+-inf:0:14:-1.5707963267949
+-inf:+1:14:-1.5707963267949
+-inf:+inf:14:-0.78539816339745
+
+-1:-inf:14:-3.1415926535898
+-1:-1:14:-2.3561944901923
+-1:0:14:-1.5707963267949
+-1:+1:14:-0.78539816339745
+-1:+inf:14:0
+
+0:-inf:14:3.1415926535898
+0:-1:14:3.1415926535898
+0:0:14:0
+0:+1:14:0
+0:+inf:14:0
+
++1:-inf:14:3.1415926535898
++1:-1:14:2.3561944901923
++1:0:14:1.5707963267949
++1:+1:14:0.78539816339745
++1:+inf:14:0
+
++inf:-inf:14:2.3561944901923
++inf:-1:14:1.5707963267949
++inf:0:14:1.5707963267949
++inf:+1:14:1.5707963267949
++inf:+inf:14:0.78539816339745
+
1:5:13:0.1973955598499
1:5:14:0.19739555984988
-0:0:10:0
-0:1:14:0
0:2:14:0
-1:0:14:1.5707963267949
5:0:14:1.5707963267949
-1:0:11:-1.5707963268
-2:0:77:-1.5707963267948966192313216916397514420985846996875529104874722961539082031431
@@ -484,16 +637,17 @@ inf:+inf:14:0.7853981633974
1:5:14:0.19739555984988
-1:8:14:-0.12435499454676
1:8:14:0.12435499454676
--1:1:14:-0.78539816339744
# test an argument X > 1 and one X < 1
1:2:24:0.463647609000806116214256
2:1:14:1.1071487177941
-2:1:14:-1.1071487177941
+
&bpi
150:3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940813
77:3.1415926535897932384626433832795028841971693993751058209749445923078164062862
+0:3.141592653589793238462643383279502884197
11:3.1415926536
+
&bnok
+inf:10:inf
NaN:NaN:NaN
@@ -513,6 +667,7 @@ NaN:1:NaN
2:0:1
7:0:1
2:1:2
+
&blog
0::-inf
-1::NaN
@@ -527,9 +682,9 @@ NaN:1:NaN
1:2:0
2::0.6931471805599453094172321214581765680755
2.718281828::0.9999999998311266953289851340574956564911
-$div_scale = 20;
+$div_scale = 20
2.718281828::0.99999999983112669533
-$div_scale = 15;
+$div_scale = 15
123::4.81218435537242
10::2.30258509299405
1000::6.90775527898214
@@ -542,8 +697,9 @@ $div_scale = 15;
10:10:1
100:100:1
# reset for further tests
-$div_scale = 40;
+$div_scale = 40
1::0
+
&brsft
NaNbrsft:2:NaN
0:2:0
@@ -552,6 +708,7 @@ NaNbrsft:2:NaN
4:1:2
123:1:61.5
32:3:4
+
&blsft
NaNblsft:0:NaN
2:1:4
@@ -559,6 +716,7 @@ NaNblsft:0:NaN
5:3:40
1:2:4
0:5:0
+
&bnorm
1:1
-0:0
@@ -602,6 +760,7 @@ bnormNaN:NaN
-00e+3:0
-00e-03:0
-00e+03:0
+
&as_number
0:0
1:1
@@ -640,10 +799,12 @@ NaN:NaN
0.1234567:0
0.12345678:0
0.123456789:0
+
&binf
1:+:inf
2:-:-inf
3:abc:inf
+
&as_hex
+inf:inf
-inf:-inf
@@ -651,6 +812,7 @@ hexNaN:NaN
0:0x0
5:0x5
-5:-0x5
+
&as_bin
+inf:inf
-inf:-inf
@@ -658,6 +820,7 @@ hexNaN:NaN
0:0b0
5:0b101
-5:-0b101
+
&numify
# uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output
0:0
@@ -666,11 +829,13 @@ hexNaN:NaN
-5:-5
100:100
-100:-100
+
&bnan
abc:NaN
2:NaN
-2:NaN
0:NaN
+
&bone
2:+:1
-2:-:-1
@@ -680,6 +845,7 @@ abc:NaN
-2::1
abc::1
2:abc:1
+
&bsstr
+inf:inf
-inf:-inf
@@ -689,6 +855,7 @@ abcfsstr:NaN
123:123e+0
-5:-5e+0
-100:-1e+2
+
&bstr
+inf:::inf
-inf:::-inf
@@ -700,11 +867,12 @@ abcfstr:::NaN
0.001234::-8:0.00123400
0:4::0
0::-4:0.0000
+
&bnorm
inf:inf
+inf:inf
-inf:-inf
-+infinity:NaN
++infinity:inf
+-inf:NaN
abc:NaN
1 a:NaN
@@ -756,6 +924,7 @@ abc:NaN
1.1e1:11
-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
+
&bpow
NaN:1:NaN
1:NaN:NaN
@@ -797,9 +966,10 @@ abc:123.456:NaN
2:0.5:1.41421356237309504880168872420969807857
#2:0.2:1.148698354997035006798626946777927589444
#6:1.5:14.6969384566990685891837044482353483518
-$div_scale = 20;
+$div_scale = 20
#62.5:12.5:26447206647554886213592.3959144
-$div_scale = 40;
+$div_scale = 40
+
&bneg
bnegNaN:NaN
+inf:-inf
@@ -811,6 +981,7 @@ bnegNaN:NaN
-123456789:123456789
+123.456789:-123.456789
-123456.789:123456.789
+
&babs
babsNaN:NaN
+inf:inf
@@ -822,6 +993,7 @@ babsNaN:NaN
-123456789:123456789
+123.456789:123.456789
-123456.789:123456.789
+
&bround
$round_mode = "trunc"
+inf:5:inf
@@ -897,6 +1069,7 @@ $round_mode = "common"
+601234300:6:601234000
+60123456789.0123:5:60123000000
-60123456789.0123:5:-60123000000
+
&bfround
$round_mode = "trunc"
+inf:5:inf
@@ -1032,6 +1205,7 @@ $round_mode = "even"
0.01234567:-8:0.01234567
0.01234567:-9:0.012345670
0.01234567:-12:0.012345670000
+
&bcmp
bcmpNaN:bcmpNaN:
bcmpNaN:+0:
@@ -1104,6 +1278,7 @@ bcmpNaN:+0:
NaN:inf:
-inf:NaN:
NaN:-inf:
+
&bacmp
bcmpNaN:bcmpNaN:
bcmpNaN:+0:
@@ -1178,6 +1353,7 @@ bcmpNaN:+0:
bacmpNaN:inf:
-inf:bacmpNaN:
bacmpNaN:-inf:
+
&bdec
bdecNaN:NaN
+inf:inf
@@ -1193,6 +1369,7 @@ bdecNaN:NaN
-99:-100
-98:-99
99:98
+
&binc
bincNaN:NaN
+inf:inf
@@ -1207,6 +1384,7 @@ bincNaN:NaN
-99:-98
-101:-100
99:100
+
&badd
abc:abc:NaN
abc:+0:NaN
@@ -1254,6 +1432,7 @@ baddNaN:+inf:NaN
-123456789:-987654321:-1111111110
+123456789:-987654321:-864197532
0.001234:0.0001234:0.0013574
+
&bsub
abc:abc:NaN
abc:+0:NaN
@@ -1300,6 +1479,7 @@ baddNaN:+inf:NaN
-123456789:+987654321:-1111111110
-123456789:-987654321:864197532
+123456789:-987654321:1111111110
+
&bmuladd
abc:abc:0:NaN
abc:+0:0:NaN
@@ -1361,12 +1541,14 @@ NaNmul:-inf:0:NaN
9999999999999999999:10000000000000000000:1234567890:99999999999999999990000000001234567890
3.2:5.7:8.9:27.14
-3.2:5.197:6.05:-10.5804
+
&bmodpow
3:4:8:1
3:4:7:4
3:4:7:4
77777:777:123456789:99995084
3.2:6.2:5.2:2.970579856718063040273642739529400818
+
&bmul
abc:abc:NaN
abc:+0:NaN
@@ -1418,6 +1600,7 @@ NaNmul:-inf:NaN
+99999999999:+9:899999999991
6:120:720
10:10000:100000
+
&bdiv-list
0:0:NaN,0
0:1:0,0
@@ -1428,8 +1611,9 @@ NaNmul:-inf:NaN
2.1:1:2.1,0
-2.1:-1:2.1,0
-2.1:1:-2.1,0
+
&bdiv
-$div_scale = 40; $round_mode = 'even'
+$div_scale = 40; $round_mode = "even"
abc:abc:NaN
abc:+1:abc:NaN
+1:abc:NaN
@@ -1505,6 +1689,7 @@ $div_scale = 1
123456789.1234:1:100000000
# reset scale for further tests
$div_scale = 40
+
&bmod
+9:4:1
+9:5:4
@@ -1595,6 +1780,7 @@ abc:1:abc:NaN
3:1:0
-3:-1:0
3:-1:0
+
&bfac
Nanfac:NaN
-1:NaN
@@ -1610,6 +1796,7 @@ Nanfac:NaN
10:3628800
11:39916800
12:479001600
+
&broot
# sqrt()
+0:2:0
@@ -1660,6 +1847,7 @@ NaN:inf:NaN
16:4:2
81:4:3
# see t/bigroot() for more tests
+
&bsqrt
+0:0
-1:NaN
@@ -1686,11 +1874,13 @@ nanbsqrt:NaN
12:3.464101615137754587054892683011744733886
0.49:0.7
0.0049:0.07
+
&is_nan
123:0
abc:1
NaN:1
-123:0
+
&is_inf
+inf::1
-inf::1
@@ -1702,9 +1892,13 @@ NaN::0
+inf:+:1
-inf:-:1
-inf:+:0
-# it must be exactly /^[+-]inf$/
-+infinity::0
--infinity::0
+-inf:-inf:1
+-inf:+inf:0
++inf:-inf:0
++inf:+inf:1
++iNfInItY::1
+-InFiNiTy::1
+
&is_odd
abc:0
0:0
@@ -1719,6 +1913,7 @@ abc:0
123.45:0
-123.45:0
2:0
+
&is_int
NaNis_int:0
0:1
@@ -1731,6 +1926,7 @@ NaNis_int:0
123.4567:0
-0.1:0
-0.002:0
+
&is_even
abc:0
0:1
@@ -1750,6 +1946,7 @@ abc:0
120:1
1200:1
-1200:1
+
&is_positive
0:0
1:1
@@ -1758,6 +1955,7 @@ abc:0
NaN:0
-inf:0
+inf:1
+
&is_negative
0:0
1:0
@@ -1766,6 +1964,7 @@ NaN:0
NaN:0
-inf:1
+inf:0
+
&parts
0:0 0
1:1 0
@@ -1775,6 +1974,7 @@ NaN:0
NaNparts:NaN NaN
+inf:inf inf
-inf:-inf inf
+
&exponent
0:0
1:0
@@ -1784,6 +1984,7 @@ NaNparts:NaN NaN
+inf:inf
-inf:inf
NaNexponent:NaN
+
&mantissa
0:0
1:1
@@ -1793,12 +1994,14 @@ NaNexponent:NaN
+inf:inf
-inf:-inf
NaNmantissa:NaN
+
&length
123:3
-123:3
0:1
1:1
12345678901234567890:20
+
&is_zero
NaNzero:0
+inf:0
@@ -1806,6 +2009,7 @@ NaNzero:0
0:1
-1:0
1:0
+
&is_one
NaNone:0
+inf:0
@@ -1815,6 +2019,7 @@ NaNone:0
1:1
-1:0
-2:0
+
&bfloor
0:0
abc:NaN
@@ -1829,6 +2034,7 @@ abc:NaN
0.1234567:0
0.12345678:0
0.123456789:0
+
&bceil
0:0
abc:NaN
@@ -1839,6 +2045,7 @@ abc:NaN
-51.2:-51
12.2:13
-0.4:0
+
&bint
0:0
NaN:NaN
@@ -1850,6 +2057,7 @@ NaN:NaN
12.2:12
-0.4:0
# overloaded functions
+
&log
-1:NaN
0:-inf
@@ -1861,11 +2069,19 @@ NaN:NaN
-inf:inf
inf:inf
NaN:NaN
+
&exp
+
&sin
+
&cos
+
&atan2
+
&int
+
&neg
+
&abs
+
&sqrt
diff --git a/cpan/Math-BigInt/t/bigfltpm.t b/cpan/Math-BigInt/t/bigfltpm.t
index e84b602ad3..2c76155c67 100644
--- a/cpan/Math-BigInt/t/bigfltpm.t
+++ b/cpan/Math-BigInt/t/bigfltpm.t
@@ -1,34 +1,36 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 2363
- + 5; # own tests
+use warnings;
+use Test::More tests => 2409 # tests in require'd file
+ + 5; # tests in this file
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigFloat";
-$CL = "Math::BigInt::Calc";
+our $CLASS = "Math::BigFloat";
+our $CALC = "Math::BigInt::Calc"; # backend
-is ($class->config()->{class},$class);
-is ($class->config()->{with}, $CL);
+is($CLASS->config()->{class}, $CLASS, "$CLASS->config()->{class}");
+is($CLASS->config()->{with}, $CALC, "$CLASS->config()->{with}");
# bug #17447: Can't call method Math::BigFloat->bsub, not a valid method
-my $c = Math::BigFloat->new( '123.3' );
-is ($c->bsub(123), '0.3'); # calling bsub on a BigFloat works
+my $c = Math::BigFloat->new('123.3');
+is($c->bsub(123), '0.3',
+ qq|\$c = Math::BigFloat -> new("123.3"); \$y = \$c -> bsub("123")|);
-# Bug until BigInt v1.86, the scale wasn't treated as a scalar:
-$c = Math::BigFloat->new('0.008'); my $d = Math::BigFloat->new(3);
-my $e = $c->bdiv(Math::BigFloat->new(3),$d);
+# Bug until Math::BigInt v1.86, the scale wasn't treated as a scalar:
+$c = Math::BigFloat->new('0.008');
+my $d = Math::BigFloat->new(3);
+my $e = $c->bdiv(Math::BigFloat->new(3), $d);
-is ($e,'0.00267'); # '0.008 / 3 => 0.0027');
+is($e, '0.00267', '0.008 / 3 = 0.0027');
SKIP: {
skip("skipping test which is not for this backend", 1)
- unless $CL eq 'Math::BigInt::Calc';
- is (ref($e->{_e}->[0]), ''); # 'Not a BigInt');
+ unless $CALC eq 'Math::BigInt::Calc';
+ is(ref($e->{_e}->[0]), '', '$e->{_e}->[0] is a scalar');
}
require 't/bigfltpm.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/bigintc.t b/cpan/Math-BigInt/t/bigintc.t
index d5837f0890..48d0d47460 100644
--- a/cpan/Math-BigInt/t/bigintc.t
+++ b/cpan/Math-BigInt/t/bigintc.t
@@ -1,12 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
+
use Test::More tests => 379;
use Math::BigInt::Calc;
-my ($BASE_LEN, undef, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) =
- Math::BigInt::Calc->_base_len();
+my ($BASE_LEN, undef, $AND_BITS, $XOR_BITS, $OR_BITS,
+ $BASE_LEN_SMALL, $MAX_VAL)
+ = Math::BigInt::Calc->_base_len();
print "# BASE_LEN = $BASE_LEN\n";
print "# MAX_VAL = $MAX_VAL\n";
@@ -16,437 +19,728 @@ print "# IOR_BITS = $OR_BITS\n";
# testing of Math::BigInt::Calc
-my $C = 'Math::BigInt::Calc'; # pass classname to sub's
+my $CALC = 'Math::BigInt::Calc'; # pass classname to sub's
# _new and _str
-my $x = $C->_new("123"); my $y = $C->_new("321");
-is (ref($x),'ARRAY'); is ($C->_str($x),123); is ($C->_str($y),321);
+
+my $x = $CALC->_new("123");
+my $y = $CALC->_new("321");
+is(ref($x), "ARRAY", q|ref($x) is an ARRAY|);
+is($CALC->_str($x), 123, qq|$CALC->_str(\$x) = 123|);
+is($CALC->_str($y), 321, qq|$CALC->_str(\$y) = 321|);
###############################################################################
# _add, _sub, _mul, _div
-is ($C->_str($C->_add($x,$y)),444);
-is ($C->_str($C->_sub($x,$y)),123);
-is ($C->_str($C->_mul($x,$y)),39483);
-is ($C->_str($C->_div($x,$y)),123);
+
+is($CALC->_str($CALC->_add($x, $y)), 444,
+ qq|$CALC->_str($CALC->_add(\$x, \$y)) = 444|);
+is($CALC->_str($CALC->_sub($x, $y)), 123,
+ qq|$CALC->_str($CALC->_sub(\$x, \$y)) = 123|);
+is($CALC->_str($CALC->_mul($x, $y)), 39483,
+ qq|$CALC->_str($CALC->_mul(\$x, \$y)) = 39483|);
+is($CALC->_str($CALC->_div($x, $y)), 123,
+ qq|$CALC->_str($CALC->_div(\$x, \$y)) = 123|);
###############################################################################
# check that mul/div doesn't change $y
# and returns the same reference, not something new
-is ($C->_str($C->_mul($x,$y)),39483);
-is ($C->_str($x),39483); is ($C->_str($y),321);
-
-is ($C->_str($C->_div($x,$y)),123);
-is ($C->_str($x),123); is ($C->_str($y),321);
-$x = $C->_new("39483");
-my ($x1,$r1) = $C->_div($x,$y);
-is ("$x1","$x");
-$C->_inc($x1);
-is ("$x1","$x");
-is ($C->_str($r1),'0');
-
-$x = $C->_new("39483"); # reset
+is($CALC->_str($CALC->_mul($x, $y)), 39483,
+ qq|$CALC->_str($CALC->_mul(\$x, \$y)) = 39483|);
+is($CALC->_str($x), 39483,
+ qq|$CALC->_str(\$x) = 39483|);
+is($CALC->_str($y), 321,
+ qq|$CALC->_str(\$y) = 321|);
+
+is($CALC->_str($CALC->_div($x, $y)), 123,
+ qq|$CALC->_str($CALC->_div(\$x, \$y)) = 123|);
+is($CALC->_str($x), 123,
+ qq|$CALC->_str(\$x) = 123|);
+is($CALC->_str($y), 321,
+ qq|$CALC->_str(\$y) = 321|);
+
+$x = $CALC->_new("39483");
+my ($x1, $r1) = $CALC->_div($x, $y);
+is("$x1", "$x", q|"$x1" = "$x"|);
+$CALC->_inc($x1);
+is("$x1", "$x", q|"$x1" = "$x"|);
+is($CALC->_str($r1), "0", qq|$CALC->_str(\$r1) = "0"|);
+
+$x = $CALC->_new("39483"); # reset
###############################################################################
-my $z = $C->_new("2");
-is ($C->_str($C->_add($x,$z)),39485);
-my ($re,$rr) = $C->_div($x,$y);
-is ($C->_str($re),123); is ($C->_str($rr),2);
+my $z = $CALC->_new("2");
+is($CALC->_str($CALC->_add($x, $z)), 39485,
+ qq|$CALC->_str($CALC->_add(\$x, \$z)) = 39485|);
+my ($re, $rr) = $CALC->_div($x, $y);
+
+is($CALC->_str($re), 123, qq|$CALC->_str(\$re) = 123|);
+is($CALC->_str($rr), 2, qq|$CALC->_str(\$rr) = 2|);
# is_zero, _is_one, _one, _zero
-is ($C->_is_zero($x)||0,0);
-is ($C->_is_one($x)||0,0);
-is ($C->_str($C->_zero()),"0");
-is ($C->_str($C->_one()),"1");
+is($CALC->_is_zero($x) || 0, 0, qq/$CALC->_is_zero(\$x) || 0 = 0/);
+is($CALC->_is_one($x) || 0, 0, qq/$CALC->_is_one(\$x) || 0 = 0/);
+
+is($CALC->_str($CALC->_zero()), "0", qq|$CALC->_str($CALC->_zero()) = "0"|);
+is($CALC->_str($CALC->_one()), "1", qq|$CALC->_str($CALC->_one()) = "1"|);
# _two() and _ten()
-is ($C->_str($C->_two()),"2");
-is ($C->_str($C->_ten()),"10");
-is ($C->_is_ten($C->_two()),0);
-is ($C->_is_two($C->_two()),1);
-is ($C->_is_ten($C->_ten()),1);
-is ($C->_is_two($C->_ten()),0);
-is ($C->_is_one($C->_one()),1);
-is ($C->_is_one($C->_two()),0);
-is ($C->_is_one($C->_ten()),0);
+is($CALC->_str($CALC->_two()), "2", qq|$CALC->_str($CALC->_two()) = "2"|);
+is($CALC->_str($CALC->_ten()), "10", qq|$CALC->_str($CALC->_ten()) = "10"|);
+is($CALC->_is_ten($CALC->_two()), 0, qq|$CALC->_is_ten($CALC->_two()) = 0|);
+is($CALC->_is_two($CALC->_two()), 1, qq|$CALC->_is_two($CALC->_two()) = 1|);
+is($CALC->_is_ten($CALC->_ten()), 1, qq|$CALC->_is_ten($CALC->_ten()) = 1|);
+is($CALC->_is_two($CALC->_ten()), 0, qq|$CALC->_is_two($CALC->_ten()) = 0|);
+
+is($CALC->_is_one($CALC->_one()), 1, qq|$CALC->_is_one($CALC->_one()) = 1|);
+is($CALC->_is_one($CALC->_two()), 0, qq|$CALC->_is_one($CALC->_two()) = 0|);
+is($CALC->_is_one($CALC->_ten()), 0, qq|$CALC->_is_one($CALC->_ten()) = 0|);
-is ($C->_is_one($C->_zero()) || 0,0);
+is($CALC->_is_one($CALC->_zero()) || 0, 0,
+ qq/$CALC->_is_one($CALC->_zero()) || 0 = 0/);
-is ($C->_is_zero($C->_zero()),1);
+is($CALC->_is_zero($CALC->_zero()), 1,
+ qq|$CALC->_is_zero($CALC->_zero()) = 1|);
-is ($C->_is_zero($C->_one()) || 0,0);
+is($CALC->_is_zero($CALC->_one()) || 0, 0,
+ qq/$CALC->_is_zero($CALC->_one()) || 0 = 0/);
# is_odd, is_even
-is ($C->_is_odd($C->_one()),1); is ($C->_is_odd($C->_zero())||0,0);
-is ($C->_is_even($C->_one()) || 0,0); is ($C->_is_even($C->_zero()),1);
+
+is($CALC->_is_odd($CALC->_one()), 1,
+ qq/$CALC->_is_odd($CALC->_one()) = 1/);
+is($CALC->_is_odd($CALC->_zero()) || 0, 0,
+ qq/$CALC->_is_odd($CALC->_zero()) || 0 = 0/);
+is($CALC->_is_even($CALC->_one()) || 0, 0,
+ qq/$CALC->_is_even($CALC->_one()) || 0 = 0/);
+is($CALC->_is_even($CALC->_zero()), 1,
+ qq/$CALC->_is_even($CALC->_zero()) = 1/);
# _len
-for my $method (qw/_alen _len/)
- {
- $x = $C->_new("1"); is ($C->$method($x),1);
- $x = $C->_new("12"); is ($C->$method($x),2);
- $x = $C->_new("123"); is ($C->$method($x),3);
- $x = $C->_new("1234"); is ($C->$method($x),4);
- $x = $C->_new("12345"); is ($C->$method($x),5);
- $x = $C->_new("123456"); is ($C->$method($x),6);
- $x = $C->_new("1234567"); is ($C->$method($x),7);
- $x = $C->_new("12345678"); is ($C->$method($x),8);
- $x = $C->_new("123456789"); is ($C->$method($x),9);
-
- $x = $C->_new("8"); is ($C->$method($x),1);
- $x = $C->_new("21"); is ($C->$method($x),2);
- $x = $C->_new("321"); is ($C->$method($x),3);
- $x = $C->_new("4321"); is ($C->$method($x),4);
- $x = $C->_new("54321"); is ($C->$method($x),5);
- $x = $C->_new("654321"); is ($C->$method($x),6);
- $x = $C->_new("7654321"); is ($C->$method($x),7);
- $x = $C->_new("87654321"); is ($C->$method($x),8);
- $x = $C->_new("987654321"); is ($C->$method($x),9);
-
- $x = $C->_new("0"); is ($C->$method($x),1);
- $x = $C->_new("20"); is ($C->$method($x),2);
- $x = $C->_new("320"); is ($C->$method($x),3);
- $x = $C->_new("4320"); is ($C->$method($x),4);
- $x = $C->_new("54320"); is ($C->$method($x),5);
- $x = $C->_new("654320"); is ($C->$method($x),6);
- $x = $C->_new("7654320"); is ($C->$method($x),7);
- $x = $C->_new("87654320"); is ($C->$method($x),8);
- $x = $C->_new("987654320"); is ($C->$method($x),9);
-
- for (my $i = 1; $i < 9; $i++)
- {
- my $a = "$i" . '0' x ($i-1);
- $x = $C->_new($a);
- print "# Tried len '$a'\n" unless is ($C->_len($x),$i);
+
+for my $method (qw/_alen _len/) {
+ $x = $CALC->_new("1");
+ is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|);
+ $x = $CALC->_new("12");
+ is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|);
+ $x = $CALC->_new("123");
+ is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|);
+ $x = $CALC->_new("1234");
+ is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|);
+ $x = $CALC->_new("12345");
+ is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|);
+ $x = $CALC->_new("123456");
+ is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|);
+ $x = $CALC->_new("1234567");
+ is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|);
+ $x = $CALC->_new("12345678");
+ is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|);
+ $x = $CALC->_new("123456789");
+ is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|);
+
+ $x = $CALC->_new("8");
+ is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|);
+ $x = $CALC->_new("21");
+ is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|);
+ $x = $CALC->_new("321");
+ is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|);
+ $x = $CALC->_new("4321");
+ is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|);
+ $x = $CALC->_new("54321");
+ is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|);
+ $x = $CALC->_new("654321");
+ is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|);
+ $x = $CALC->_new("7654321");
+ is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|);
+ $x = $CALC->_new("87654321");
+ is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|);
+ $x = $CALC->_new("987654321");
+ is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|);
+
+ $x = $CALC->_new("0");
+ is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|);
+ $x = $CALC->_new("20");
+ is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|);
+ $x = $CALC->_new("320");
+ is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|);
+ $x = $CALC->_new("4320");
+ is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|);
+ $x = $CALC->_new("54320");
+ is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|);
+ $x = $CALC->_new("654320");
+ is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|);
+ $x = $CALC->_new("7654320");
+ is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|);
+ $x = $CALC->_new("87654320");
+ is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|);
+ $x = $CALC->_new("987654320");
+ is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|);
+
+ for (my $i = 1; $i < 9; $i++) {
+ my $a = "$i" . '0' x ($i - 1);
+ $x = $CALC->_new($a);
+ is($CALC->_len($x), $i, qq|$CALC->_len(\$x) = $i|);
}
- }
+}
# _digit
-$x = $C->_new("123456789");
-is ($C->_digit($x,0),9);
-is ($C->_digit($x,1),8);
-is ($C->_digit($x,2),7);
-is ($C->_digit($x,8),1);
-is ($C->_digit($x,9),0);
-is ($C->_digit($x,-1),1);
-is ($C->_digit($x,-2),2);
-is ($C->_digit($x,-3),3);
-is ($C->_digit($x,-9),9);
-is ($C->_digit($x,-10),0);
+
+$x = $CALC->_new("123456789");
+is($CALC->_digit($x, 0), 9, qq|$CALC->_digit(\$x, 0) = 9|);
+is($CALC->_digit($x, 1), 8, qq|$CALC->_digit(\$x, 1) = 8|);
+is($CALC->_digit($x, 2), 7, qq|$CALC->_digit(\$x, 2) = 7|);
+is($CALC->_digit($x, 8), 1, qq|$CALC->_digit(\$x, 8) = 1|);
+is($CALC->_digit($x, 9), 0, qq|$CALC->_digit(\$x, 9) = 0|);
+is($CALC->_digit($x, -1), 1, qq|$CALC->_digit(\$x, -1) = 1|);
+is($CALC->_digit($x, -2), 2, qq|$CALC->_digit(\$x, -2) = 2|);
+is($CALC->_digit($x, -3), 3, qq|$CALC->_digit(\$x, -3) = 3|);
+is($CALC->_digit($x, -9), 9, qq|$CALC->_digit(\$x, -9) = 9|);
+is($CALC->_digit($x, -10), 0, qq|$CALC->_digit(\$x, -10) = 0|);
# _copy
-foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/)
- {
- $x = $C->_new("$_");
- is ($C->_str($C->_copy($x)),"$_");
- is ($C->_str($x),"$_"); # did _copy destroy original x?
- }
+
+foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/) {
+ $x = $CALC->_new("$_");
+ is($CALC->_str($CALC->_copy($x)), "$_",
+ qq|$CALC->_str($CALC->_copy(\$x)) = "$_"|);
+ is($CALC->_str($x), "$_", # did _copy destroy original x?
+ qq|$CALC->_str(\$x) = "$_"|);
+}
# _zeros
-$x = $C->_new("1256000000"); is ($C->_zeros($x),6);
-$x = $C->_new("152"); is ($C->_zeros($x),0);
-$x = $C->_new("123000"); is ($C->_zeros($x),3);
-$x = $C->_new("0"); is ($C->_zeros($x),0);
-# _lsft, _rsft
-$x = $C->_new("10"); $y = $C->_new("3");
-is ($C->_str($C->_lsft($x,$y,10)),10000);
-$x = $C->_new("20"); $y = $C->_new("3");
-is ($C->_str($C->_lsft($x,$y,10)),20000);
+$x = $CALC->_new("1256000000");
+is($CALC->_zeros($x), 6, qq|$CALC->_zeros(\$x) = 6|);
-$x = $C->_new("128"); $y = $C->_new("4");
-is ($C->_str($C->_lsft($x,$y,2)), 128 << 4);
+$x = $CALC->_new("152");
+is($CALC->_zeros($x), 0, qq|$CALC->_zeros(\$x) = 0|);
-$x = $C->_new("1000"); $y = $C->_new("3");
-is ($C->_str($C->_rsft($x,$y,10)),1);
-$x = $C->_new("20000"); $y = $C->_new("3");
-is ($C->_str($C->_rsft($x,$y,10)),20);
-$x = $C->_new("256"); $y = $C->_new("4");
-is ($C->_str($C->_rsft($x,$y,2)),256 >> 4);
+$x = $CALC->_new("123000");
+is($CALC->_zeros($x), 3, qq|$CALC->_zeros(\$x) = 3|);
-$x = $C->_new("6411906467305339182857313397200584952398");
-$y = $C->_new("45");
-is ($C->_str($C->_rsft($x,$y,10)),0);
+$x = $CALC->_new("0");
+is($CALC->_zeros($x), 0, qq|$CALC->_zeros(\$x) = 0|);
+
+# _lsft, _rsft
+
+$x = $CALC->_new("10");
+$y = $CALC->_new("3");
+is($CALC->_str($CALC->_lsft($x, $y, 10)), 10000,
+ qq|$CALC->_str($CALC->_lsft(\$x, \$y, 10)) = 10000|);
+
+$x = $CALC->_new("20");
+$y = $CALC->_new("3");
+is($CALC->_str($CALC->_lsft($x, $y, 10)), 20000,
+ qq|$CALC->_str($CALC->_lsft(\$x, \$y, 10)) = 20000|);
+
+$x = $CALC->_new("128");
+$y = $CALC->_new("4");
+is($CALC->_str($CALC->_lsft($x, $y, 2)), 128 << 4,
+ qq|$CALC->_str($CALC->_lsft(\$x, \$y, 2)) = 128 << 4|);
+
+$x = $CALC->_new("1000");
+$y = $CALC->_new("3");
+is($CALC->_str($CALC->_rsft($x, $y, 10)), 1,
+ qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 1|);
+
+$x = $CALC->_new("20000");
+$y = $CALC->_new("3");
+is($CALC->_str($CALC->_rsft($x, $y, 10)), 20,
+ qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 20|);
+
+$x = $CALC->_new("256");
+$y = $CALC->_new("4");
+is($CALC->_str($CALC->_rsft($x, $y, 2)), 256 >> 4,
+ qq|$CALC->_str($CALC->_rsft(\$x, \$y, 2)) = 256 >> 4|);
+
+$x = $CALC->_new("6411906467305339182857313397200584952398");
+$y = $CALC->_new("45");
+is($CALC->_str($CALC->_rsft($x, $y, 10)), 0,
+ qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 0|);
# _acmp
-$x = $C->_new("123456789");
-$y = $C->_new("987654321");
-is ($C->_acmp($x,$y),-1);
-is ($C->_acmp($y,$x),1);
-is ($C->_acmp($x,$x),0);
-is ($C->_acmp($y,$y),0);
-$x = $C->_new("12");
-$y = $C->_new("12");
-is ($C->_acmp($x,$y),0);
-$x = $C->_new("21");
-is ($C->_acmp($x,$y),1);
-is ($C->_acmp($y,$x),-1);
-$x = $C->_new("123456789");
-$y = $C->_new("1987654321");
-is ($C->_acmp($x,$y),-1);
-is ($C->_acmp($y,$x),+1);
-
-$x = $C->_new("1234567890123456789");
-$y = $C->_new("987654321012345678");
-is ($C->_acmp($x,$y),1);
-is ($C->_acmp($y,$x),-1);
-is ($C->_acmp($x,$x),0);
-is ($C->_acmp($y,$y),0);
-
-$x = $C->_new("1234");
-$y = $C->_new("987654321012345678");
-is ($C->_acmp($x,$y),-1);
-is ($C->_acmp($y,$x),1);
-is ($C->_acmp($x,$x),0);
-is ($C->_acmp($y,$y),0);
+
+$x = $CALC->_new("123456789");
+$y = $CALC->_new("987654321");
+is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|);
+is($CALC->_acmp($y, $x), 1, qq|$CALC->_acmp(\$y, \$x) = 1|);
+is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|);
+is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|);
+$x = $CALC->_new("12");
+$y = $CALC->_new("12");
+is($CALC->_acmp($x, $y), 0, qq|$CALC->_acmp(\$x, \$y) = 0|);
+$x = $CALC->_new("21");
+is($CALC->_acmp($x, $y), 1, qq|$CALC->_acmp(\$x, \$y) = 1|);
+is($CALC->_acmp($y, $x), -1, qq|$CALC->_acmp(\$y, \$x) = -1|);
+$x = $CALC->_new("123456789");
+$y = $CALC->_new("1987654321");
+is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|);
+is($CALC->_acmp($y, $x), +1, qq|$CALC->_acmp(\$y, \$x) = +1|);
+
+$x = $CALC->_new("1234567890123456789");
+$y = $CALC->_new("987654321012345678");
+is($CALC->_acmp($x, $y), 1, qq|$CALC->_acmp(\$x, \$y) = 1|);
+is($CALC->_acmp($y, $x), -1, qq|$CALC->_acmp(\$y, \$x) = -1|);
+is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|);
+is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|);
+
+$x = $CALC->_new("1234");
+$y = $CALC->_new("987654321012345678");
+is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|);
+is($CALC->_acmp($y, $x), 1, qq|$CALC->_acmp(\$y, \$x) = 1|);
+is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|);
+is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|);
# _modinv
-$x = $C->_new("8");
-$y = $C->_new("5033");
-my ($xmod,$sign) = $C->_modinv($x,$y);
-is ($C->_str($xmod),'629'); # -629 % 5033 == 4404
-is ($sign, '-');
+
+$x = $CALC->_new("8");
+$y = $CALC->_new("5033");
+my ($xmod, $sign) = $CALC->_modinv($x, $y);
+is($CALC->_str($xmod), "629", # -629 % 5033 == 4404
+ qq|$CALC->_str(\$xmod) = "629"|);
+is($sign, "-", q|$sign = "-"|);
# _div
-$x = $C->_new("3333"); $y = $C->_new("1111");
-is ($C->_str(scalar $C->_div($x,$y)),3);
-$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
-is ($C->_str($x),30); is ($C->_str($y),3);
-$x = $C->_new("123"); $y = $C->_new("1111");
-($x,$y) = $C->_div($x,$y); is ($C->_str($x),0); is ($C->_str($y),123);
+
+$x = $CALC->_new("3333");
+$y = $CALC->_new("1111");
+is($CALC->_str(scalar($CALC->_div($x, $y))), 3,
+ qq|$CALC->_str(scalar($CALC->_div(\$x, \$y))) = 3|);
+
+$x = $CALC->_new("33333");
+$y = $CALC->_new("1111");
+($x, $y) = $CALC->_div($x, $y);
+is($CALC->_str($x), 30, qq|$CALC->_str(\$x) = 30|);
+is($CALC->_str($y), 3, qq|$CALC->_str(\$y) = 3|);
+
+$x = $CALC->_new("123");
+$y = $CALC->_new("1111");
+($x, $y) = $CALC->_div($x, $y);
+is($CALC->_str($x), 0, qq|$CALC->_str(\$x) = 0|);
+is($CALC->_str($y), 123, qq|$CALC->_str(\$y) = 123|);
# _num
-foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/)
- {
- $x = $C->_new("$_");
- is (ref($x),'ARRAY'); is ($C->_str($x),"$_");
- $x = $C->_num($x); is (ref($x),''); is ($x,$_);
- }
-# _sqrt
-$x = $C->_new("144"); is ($C->_str($C->_sqrt($x)),'12');
-$x = $C->_new("144000000000000"); is ($C->_str($C->_sqrt($x)),'12000000');
+foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) {
-# _root
-$x = $C->_new("81"); my $n = $C->_new("3"); # 4*4*4 = 64, 5*5*5 = 125
-is ($C->_str($C->_root($x,$n)),'4'); # 4.xx => 4.0
-$x = $C->_new("81"); $n = $C->_new("4"); # 3*3*3*3 == 81
-is ($C->_str($C->_root($x,$n)),'3');
+ $x = $CALC->_new("$_");
+ is(ref($x), "ARRAY", q|ref($x) = "ARRAY"|);
+ is($CALC->_str($x), "$_", qq|$CALC->_str(\$x) = "$_"|);
-# _pow (and _root)
-$x = $C->_new("0"); $n = $C->_new("3"); # 0 ** y => 0
-is ($C->_str($C->_pow($x,$n)), 0);
-$x = $C->_new("3"); $n = $C->_new("0"); # x ** 0 => 1
-is ($C->_str($C->_pow($x,$n)), 1);
-$x = $C->_new("1"); $n = $C->_new("3"); # 1 ** y => 1
-is ($C->_str($C->_pow($x,$n)), 1);
-$x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x
-is ($C->_str($C->_pow($x,$n)), 5);
+ $x = $CALC->_num($x);
+ is(ref($x), "", q|ref($x) = ""|);
+ is($x, $_, qq|\$x = $_|);
+}
-$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441
-is ($C->_str($C->_pow($x,$n)),81 ** 3);
+# _sqrt
-is ($C->_str($C->_root($x,$n)),81);
+$x = $CALC->_new("144");
+is($CALC->_str($CALC->_sqrt($x)), "12",
+ qq|$CALC->_str($CALC->_sqrt(\$x)) = "12"|);
+$x = $CALC->_new("144000000000000");
+is($CALC->_str($CALC->_sqrt($x)), "12000000",
+ qq|$CALC->_str($CALC->_sqrt(\$x)) = "12000000"|);
-$x = $C->_new("81");
-is ($C->_str($C->_pow($x,$n)),81 ** 3);
-is ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 ==
+# _root
-is ($C->_str($C->_root($x,$n)),'531441');
-is ($C->_str($C->_root($x,$n)),'81');
+$x = $CALC->_new("81");
+my $n = $CALC->_new("3"); # 4*4*4 = 64, 5*5*5 = 125
+is($CALC->_str($CALC->_root($x, $n)), "4",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "4"|); # 4.xx => 4.0
-$x = $C->_new("81"); $n = $C->_new("14");
-is ($C->_str($C->_pow($x,$n)),'523347633027360537213511521');
-is ($C->_str($C->_root($x,$n)),'81');
+$x = $CALC->_new("81");
+$n = $CALC->_new("4"); # 3*3*3*3 == 81
+is($CALC->_str($CALC->_root($x, $n)), "3",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "3"|);
-$x = $C->_new("523347633027360537213511520");
-is ($C->_str($C->_root($x,$n)),'80');
+# _pow (and _root)
-$x = $C->_new("523347633027360537213511522");
-is ($C->_str($C->_root($x,$n)),'81');
+$x = $CALC->_new("0");
+$n = $CALC->_new("3"); # 0 ** y => 0
+is($CALC->_str($CALC->_pow($x, $n)), 0,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 0|);
+
+$x = $CALC->_new("3");
+$n = $CALC->_new("0"); # x ** 0 => 1
+is($CALC->_str($CALC->_pow($x, $n)), 1,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 1|);
+
+$x = $CALC->_new("1");
+$n = $CALC->_new("3"); # 1 ** y => 1
+is($CALC->_str($CALC->_pow($x, $n)), 1,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 1|);
+
+$x = $CALC->_new("5");
+$n = $CALC->_new("1"); # x ** 1 => x
+is($CALC->_str($CALC->_pow($x, $n)), 5,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 5|);
+
+$x = $CALC->_new("81");
+$n = $CALC->_new("3"); # 81 ** 3 == 531441
+is($CALC->_str($CALC->_pow($x, $n)), 81 ** 3,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 81 ** 3|);
+
+is($CALC->_str($CALC->_root($x, $n)), 81,
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = 81|);
+
+$x = $CALC->_new("81");
+is($CALC->_str($CALC->_pow($x, $n)), 81 ** 3,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 81 ** 3|);
+is($CALC->_str($CALC->_pow($x, $n)), "150094635296999121", # 531441 ** 3
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = "150094635296999121"|);
+
+is($CALC->_str($CALC->_root($x, $n)), "531441",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "531441"|);
+is($CALC->_str($CALC->_root($x, $n)), "81",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|);
+
+$x = $CALC->_new("81");
+$n = $CALC->_new("14");
+is($CALC->_str($CALC->_pow($x, $n)), "523347633027360537213511521",
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = "523347633027360537213511521"|);
+is($CALC->_str($CALC->_root($x, $n)), "81",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|);
+
+$x = $CALC->_new("523347633027360537213511520");
+is($CALC->_str($CALC->_root($x, $n)), "80",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "80"|);
+
+$x = $CALC->_new("523347633027360537213511522");
+is($CALC->_str($CALC->_root($x, $n)), "81",
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|);
my $res = [ qw/9 31 99 316 999 3162 9999 31622 99999/ ];
# 99 ** 2 = 9801, 999 ** 2 = 998001 etc
-for my $i (2 .. 9)
- {
- $x = '9' x $i; $x = $C->_new($x);
- $n = $C->_new("2");
- my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1';
- print "# _pow( ", '9' x $i, ", 2) \n" unless
- is ($C->_str($C->_pow($x,$n)),$rc);
-
- # if $i > $BASE_LEN, the test takes a really long time:
- if ($i <= $BASE_LEN)
- {
- $x = '9' x $i; $x = $C->_new($x);
- $n = '9' x $i; $n = $C->_new($n);
- print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n";
- print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
- is ($C->_str($C->_root($x,$n)),'1');
-
- $x = '9' x $i; $x = $C->_new($x);
- $n = $C->_new("2");
- print "# BASE_LEN $BASE_LEN _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
- is ($C->_str($C->_root($x,$n)), $res->[$i-2]);
+
+for my $i (2 .. 9) {
+ $x = '9' x $i;
+ $x = $CALC->_new($x);
+ $n = $CALC->_new("2");
+ my $rc = '9' x ($i-1). '8' . '0' x ($i - 1) . '1';
+ print "# _pow( ", '9' x $i, ", 2) \n" unless
+ is($CALC->_str($CALC->_pow($x, $n)), $rc,
+ qq|$CALC->_str($CALC->_pow(\$x, \$n)) = $rc|);
+
+ SKIP: {
+ # If $i > $BASE_LEN, the test takes a really long time.
+ skip "$i > $BASE_LEN", 2 unless $i <= $BASE_LEN;
+
+ $x = '9' x $i;
+ $x = $CALC->_new($x);
+ $n = '9' x $i;
+ $n = $CALC->_new($n);
+ print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n";
+ print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n"
+ unless is($CALC->_str($CALC->_root($x, $n)), '1',
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = '1'|);
+
+ $x = '9' x $i;
+ $x = $CALC->_new($x);
+ $n = $CALC->_new("2");
+ print "# BASE_LEN $BASE_LEN _root( ", '9' x $i, ", ", 9 x $i, ") \n"
+ unless is($CALC->_str($CALC->_root($x, $n)), $res->[$i-2],
+ qq|$CALC->_str($CALC->_root(\$x, \$n)) = $res->[$i-2]|);
}
- else
- {
- is ("skipped $i", "skipped $i");
- is ("skipped $i", "skipped $i");
- }
- }
+}
##############################################################################
# _fac
-$x = $C->_new("0"); is ($C->_str($C->_fac($x)),'1');
-$x = $C->_new("1"); is ($C->_str($C->_fac($x)),'1');
-$x = $C->_new("2"); is ($C->_str($C->_fac($x)),'2');
-$x = $C->_new("3"); is ($C->_str($C->_fac($x)),'6');
-$x = $C->_new("4"); is ($C->_str($C->_fac($x)),'24');
-$x = $C->_new("5"); is ($C->_str($C->_fac($x)),'120');
-$x = $C->_new("10"); is ($C->_str($C->_fac($x)),'3628800');
-$x = $C->_new("11"); is ($C->_str($C->_fac($x)),'39916800');
-$x = $C->_new("12"); is ($C->_str($C->_fac($x)),'479001600');
-$x = $C->_new("13"); is ($C->_str($C->_fac($x)),'6227020800');
+
+$x = $CALC->_new("0");
+is($CALC->_str($CALC->_fac($x)), "1",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "1"|);
+
+$x = $CALC->_new("1");
+is($CALC->_str($CALC->_fac($x)), "1",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "1"|);
+
+$x = $CALC->_new("2");
+is($CALC->_str($CALC->_fac($x)), "2",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "2"|);
+
+$x = $CALC->_new("3");
+is($CALC->_str($CALC->_fac($x)), "6",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "6"|);
+
+$x = $CALC->_new("4");
+is($CALC->_str($CALC->_fac($x)), "24",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "24"|);
+
+$x = $CALC->_new("5");
+is($CALC->_str($CALC->_fac($x)), "120",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "120"|);
+
+$x = $CALC->_new("10");
+is($CALC->_str($CALC->_fac($x)), "3628800",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "3628800"|);
+
+$x = $CALC->_new("11");
+is($CALC->_str($CALC->_fac($x)), "39916800",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "39916800"|);
+
+$x = $CALC->_new("12");
+is($CALC->_str($CALC->_fac($x)), "479001600",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "479001600"|);
+
+$x = $CALC->_new("13");
+is($CALC->_str($CALC->_fac($x)), "6227020800",
+ qq|$CALC->_str($CALC->_fac(\$x)) = "6227020800"|);
# test that _fac modifies $x in place for small arguments
-$x = $C->_new("3"); $C->_fac($x); is ($C->_str($x),'6');
-$x = $C->_new("13"); $C->_fac($x); is ($C->_str($x),'6227020800');
+
+$x = $CALC->_new("3");
+$CALC->_fac($x);
+is($CALC->_str($x), "6",
+ qq|$CALC->_str(\$x) = "6"|);
+
+$x = $CALC->_new("13");
+$CALC->_fac($x);
+is($CALC->_str($x), "6227020800",
+ qq|$CALC->_str(\$x) = "6227020800"|);
##############################################################################
# _inc and _dec
-foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/)
- {
- $x = $C->_new("$_"); $C->_inc($x);
- print "# \$x = ",$C->_str($x),"\n"
- unless is ($C->_str($x),substr($_,0,length($_)-1) . '2');
- $C->_dec($x); is ($C->_str($x),$_);
- }
-foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/)
- {
- $x = $C->_new("$_"); $C->_inc($x);
- print "# \$x = ",$C->_str($x),"\n"
- unless is ($C->_str($x),substr($_,0,length($_)-2) . '20');
- $C->_dec($x); is ($C->_str($x),$_);
- }
-foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/)
- {
- $x = $C->_new("$_"); $C->_inc($x);
- print "# \$x = ",$C->_str($x),"\n"
- unless is ($C->_str($x), '1' . '0' x (length($_)));
- $C->_dec($x); is ($C->_str($x),$_);
- }
-
-$x = $C->_new("1000"); $C->_inc($x); is ($C->_str($x),'1001');
-$C->_dec($x); is ($C->_str($x),'1000');
+
+for (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/) {
+ $x = $CALC->_new("$_");
+ $CALC->_inc($x);
+ my $expected = substr($_, 0, length($_) - 1) . '2';
+ is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|);
+ $CALC->_dec($x);
+ is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|);
+}
+
+for (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/) {
+ $x = $CALC->_new("$_");
+ $CALC->_inc($x);
+ my $expected = substr($_, 0, length($_)-2) . '20';
+ is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|);
+ $CALC->_dec($x);
+ is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|);
+}
+
+for (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/) {
+ $x = $CALC->_new("$_");
+ $CALC->_inc($x);
+ my $expected = '1' . '0' x (length($_));
+ is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|);
+ $CALC->_dec($x);
+ is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|);
+}
+
+$x = $CALC->_new("1000");
+$CALC->_inc($x);
+is($CALC->_str($x), "1001", qq|$CALC->_str(\$x) = "1001"|);
+$CALC->_dec($x);
+is($CALC->_str($x), "1000", qq|$CALC->_str(\$x) = "1000"|);
my $BL;
{
- no strict 'refs';
- $BL = &{"$C"."::_base_len"}();
+ no strict 'refs';
+ $BL = &{"$CALC"."::_base_len"}();
}
$x = '1' . '0' x $BL;
-$z = '1' . '0' x ($BL-1); $z .= '1';
-$x = $C->_new($x); $C->_inc($x); is ($C->_str($x),$z);
+$z = '1' . '0' x ($BL - 1);
+$z .= '1';
+$x = $CALC->_new($x);
+$CALC->_inc($x);
+is($CALC->_str($x), $z, qq|$CALC->_str(\$x) = $z|);
-$x = '1' . '0' x $BL; $z = '9' x $BL;
-$x = $C->_new($x); $C->_dec($x); is ($C->_str($x),$z);
+$x = '1' . '0' x $BL;
+$z = '9' x $BL;
+$x = $CALC->_new($x);
+$CALC->_dec($x);
+is($CALC->_str($x), $z, qq|$CALC->_str(\$x) = $z|);
# should not happen:
-# $x = $C->_new("-2"); $y = $C->_new("4"); is ($C->_acmp($x,$y),-1);
+# $x = $CALC->_new("-2");
+# $y = $CALC->_new("4");
+# is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp($x, $y) = -1|);
###############################################################################
# _mod
-$x = $C->_new("1000"); $y = $C->_new("3");
-is ($C->_str(scalar $C->_mod($x,$y)),1);
-$x = $C->_new("1000"); $y = $C->_new("2");
-is ($C->_str(scalar $C->_mod($x,$y)),0);
+
+$x = $CALC->_new("1000");
+$y = $CALC->_new("3");
+is($CALC->_str(scalar($CALC->_mod($x, $y))), 1,
+ qq|$CALC->_str(scalar($CALC->_mod(\$x, \$y))) = 1|);
+
+$x = $CALC->_new("1000");
+$y = $CALC->_new("2");
+is($CALC->_str(scalar($CALC->_mod($x, $y))), 0,
+ qq|$CALC->_str(scalar($CALC->_mod(\$x, \$y))) = 0|);
# _and, _or, _xor
-$x = $C->_new("5"); $y = $C->_new("2");
-is ($C->_str(scalar $C->_xor($x,$y)),7);
-$x = $C->_new("5"); $y = $C->_new("2");
-is ($C->_str(scalar $C->_or($x,$y)),7);
-$x = $C->_new("5"); $y = $C->_new("3");
-is ($C->_str(scalar $C->_and($x,$y)),1);
+
+$x = $CALC->_new("5");
+$y = $CALC->_new("2");
+is($CALC->_str(scalar($CALC->_xor($x, $y))), 7,
+ qq|$CALC->_str(scalar($CALC->_xor(\$x, \$y))) = 7|);
+
+$x = $CALC->_new("5");
+$y = $CALC->_new("2");
+is($CALC->_str(scalar($CALC->_or($x, $y))), 7,
+ qq|$CALC->_str(scalar($CALC->_or(\$x, \$y))) = 7|);
+
+$x = $CALC->_new("5");
+$y = $CALC->_new("3");
+is($CALC->_str(scalar($CALC->_and($x, $y))), 1,
+ qq|$CALC->_str(scalar($CALC->_and(\$x, \$y))) = 1|);
# _from_hex, _from_bin, _from_oct
-is ($C->_str( $C->_from_hex("0xFf")),255);
-is ($C->_str( $C->_from_bin("0b10101011")),160+11);
-is ($C->_str( $C->_from_oct("0100")), 8*8);
-is ($C->_str( $C->_from_oct("01000")), 8*8*8);
-is ($C->_str( $C->_from_oct("010001")), 8*8*8*8+1);
-is ($C->_str( $C->_from_oct("010007")), 8*8*8*8+7);
+
+is($CALC->_str($CALC->_from_hex("0xFf")), 255,
+ qq|$CALC->_str($CALC->_from_hex("0xFf")) = 255|);
+is($CALC->_str($CALC->_from_bin("0b10101011")), 160+11,
+ qq|$CALC->_str($CALC->_from_bin("0b10101011")) = 160+11|);
+is($CALC->_str($CALC->_from_oct("0100")), 8*8,
+ qq|$CALC->_str($CALC->_from_oct("0100")) = 8*8|);
+is($CALC->_str($CALC->_from_oct("01000")), 8*8*8,
+ qq|$CALC->_str($CALC->_from_oct("01000")) = 8*8*8|);
+is($CALC->_str($CALC->_from_oct("010001")), 8*8*8*8+1,
+ qq|$CALC->_str($CALC->_from_oct("010001")) = 8*8*8*8+1|);
+is($CALC->_str($CALC->_from_oct("010007")), 8*8*8*8+7,
+ qq|$CALC->_str($CALC->_from_oct("010007")) = 8*8*8*8+7|);
# _as_hex, _as_bin, as_oct
-is ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("128")))), 128);
-is ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("128")))), 128);
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("128")))), 128);
-
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("123456")))), 123456);
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("123456789")))), "123456789");
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("1234567890123")))), "1234567890123");
-
-my $long = '123456789012345678901234567890';
-is ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new($long)))), $long);
-is ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new($long)))), $long);
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new($long)))), $long);
-is ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("0")))), 0);
-is ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("0")))), 0);
-is ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("0")))), 0);
-is ($C->_as_hex( $C->_new("0")), '0x0');
-is ($C->_as_bin( $C->_new("0")), '0b0');
-is ($C->_as_oct( $C->_new("0")), '00');
-is ($C->_as_hex( $C->_new("12")), '0xc');
-is ($C->_as_bin( $C->_new("12")), '0b1100');
-is ($C->_as_oct( $C->_new("64")), '0100');
+
+is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new("128")))), 128,
+ qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(|
+ . qq|$CALC->_new("128")))) = 128|);
+is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new("128")))), 128,
+ qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(|
+ . qq|$CALC->_new("128")))) = 128|);
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("128")))), 128,
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(|
+ . qq|$CALC->_new("128")))) = 128|);
+
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("123456")))),
+ 123456,
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct|
+ . qq|($CALC->_new("123456")))) = 123456|);
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("123456789")))),
+ "123456789",
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(|
+ . qq|$CALC->_new("123456789")))) = "123456789"|);
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("1234567890123")))),
+ "1234567890123",
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(|
+ . qq|$CALC->_new("1234567890123")))) = "1234567890123"|);
+
+my $long = "123456789012345678901234567890";
+is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new($long)))), $long,
+ qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(|
+ . qq|$CALC->_new("$long")))) = "$long"|);
+is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new($long)))), $long,
+ qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(|
+ . qq|$CALC->_new("$long")))) = "$long"|);
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new($long)))), $long,
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(|
+ . qq|$CALC->_new("$long")))) = "$long"|);
+
+is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new("0")))), 0,
+ qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(|
+ . qq|$CALC->_new("0")))) = 0|);
+is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new("0")))), 0,
+ qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(|
+ . qq|$CALC->_new("0")))) = 0|);
+is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("0")))), 0,
+ qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(|
+ . qq|$CALC->_new("0")))) = 0|);
+
+is($CALC->_as_hex($CALC->_new("0")), "0x0",
+ qq|$CALC->_as_hex($CALC->_new("0")) = "0x0"|);
+is($CALC->_as_bin($CALC->_new("0")), "0b0",
+ qq|$CALC->_as_bin($CALC->_new("0")) = "0b0"|);
+is($CALC->_as_oct($CALC->_new("0")), "00",
+ qq|$CALC->_as_oct($CALC->_new("0")) = "00"|);
+
+is($CALC->_as_hex($CALC->_new("12")), "0xc",
+ qq|$CALC->_as_hex($CALC->_new("12")) = "0xc"|);
+is($CALC->_as_bin($CALC->_new("12")), "0b1100",
+ qq|$CALC->_as_bin($CALC->_new("12")) = "0b1100"|);
+is($CALC->_as_oct($CALC->_new("64")), "0100",
+ qq|$CALC->_as_oct($CALC->_new("64")) = "0100"|);
# _1ex
-is ($C->_str($C->_1ex(0)), "1");
-is ($C->_str($C->_1ex(1)), "10");
-is ($C->_str($C->_1ex(2)), "100");
-is ($C->_str($C->_1ex(12)), "1000000000000");
-is ($C->_str($C->_1ex(16)), "10000000000000000");
+
+is($CALC->_str($CALC->_1ex(0)), "1",
+ qq|$CALC->_str($CALC->_1ex(0)) = "1"|);
+is($CALC->_str($CALC->_1ex(1)), "10",
+ qq|$CALC->_str($CALC->_1ex(1)) = "10"|);
+is($CALC->_str($CALC->_1ex(2)), "100",
+ qq|$CALC->_str($CALC->_1ex(2)) = "100"|);
+is($CALC->_str($CALC->_1ex(12)), "1000000000000",
+ qq|$CALC->_str($CALC->_1ex(12)) = "1000000000000"|);
+is($CALC->_str($CALC->_1ex(16)), "10000000000000000",
+ qq|$CALC->_str($CALC->_1ex(16)) = "10000000000000000"|);
# _check
-$x = $C->_new("123456789");
-is ($C->_check($x),0);
-is ($C->_check(123),'123 is not a reference');
+
+$x = $CALC->_new("123456789");
+is($CALC->_check($x), 0,
+ qq|$CALC->_check(\$x) = 0|);
+is($CALC->_check(123), "123 is not a reference",
+ qq|$CALC->_check(123) = "123 is not a reference"|);
###############################################################################
# __strip_zeros
{
- no strict 'refs';
- # correct empty arrays
- $x = &{$C."::__strip_zeros"}([]); is (@$x,1); is ($x->[0],0);
- # don't strip single elements
- $x = &{$C."::__strip_zeros"}([0]); is (@$x,1); is ($x->[0],0);
- $x = &{$C."::__strip_zeros"}([1]); is (@$x,1); is ($x->[0],1);
- # don't strip non-zero elements
- $x = &{$C."::__strip_zeros"}([0,1]);
- is (@$x,2); is ($x->[0],0); is ($x->[1],1);
- $x = &{$C."::__strip_zeros"}([0,1,2]);
- is (@$x,3); is ($x->[0],0); is ($x->[1],1); is ($x->[2],2);
-
- # but strip leading zeros
- $x = &{$C."::__strip_zeros"}([0,1,2,0]);
- is (@$x,3); is ($x->[0],0); is ($x->[1],1); is ($x->[2],2);
-
- $x = &{$C."::__strip_zeros"}([0,1,2,0,0]);
- is (@$x,3); is ($x->[0],0); is ($x->[1],1); is ($x->[2],2);
-
- $x = &{$C."::__strip_zeros"}([0,1,2,0,0,0]);
- is (@$x,3); is ($x->[0],0); is ($x->[1],1); is ($x->[2],2);
-
- # collapse multiple zeros
- $x = &{$C."::__strip_zeros"}([0,0,0,0]);
- is (@$x,1); is ($x->[0],0);
+ no strict 'refs';
+
+ # correct empty arrays
+ $x = &{$CALC."::__strip_zeros"}([]);
+ is(@$x, 1, q|@$x = 1|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+
+ # don't strip single elements
+ $x = &{$CALC."::__strip_zeros"}([0]);
+ is(@$x, 1, q|@$x = 1|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ $x = &{$CALC."::__strip_zeros"}([1]);
+ is(@$x, 1, q|@$x = 1|);
+ is($x->[0], 1, q|$x->[0] = 1|);
+
+ # don't strip non-zero elements
+ $x = &{$CALC."::__strip_zeros"}([0, 1]);
+ is(@$x, 2, q|@$x = 2|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ is($x->[1], 1, q|$x->[1] = 1|);
+ $x = &{$CALC."::__strip_zeros"}([0, 1, 2]);
+ is(@$x, 3, q|@$x = 3|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ is($x->[1], 1, q|$x->[1] = 1|);
+ is($x->[2], 2, q|$x->[2] = 2|);
+
+ # but strip leading zeros
+ $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0]);
+ is(@$x, 3, q|@$x = 3|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ is($x->[1], 1, q|$x->[1] = 1|);
+ is($x->[2], 2, q|$x->[2] = 2|);
+
+ $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0, 0]);
+ is(@$x, 3, q|@$x = 3|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ is($x->[1], 1, q|$x->[1] = 1|);
+ is($x->[2], 2, q|$x->[2] = 2|);
+
+ $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0, 0, 0]);
+ is(@$x, 3, q|@$x = 3|);
+ is($x->[0], 0, q|$x->[0] = 0|);
+ is($x->[1], 1, q|$x->[1] = 1|);
+ is($x->[2], 2, q|$x->[2] = 2|);
+
+ # collapse multiple zeros
+ $x = &{$CALC."::__strip_zeros"}([0, 0, 0, 0]);
+ is(@$x, 1, q|@$x = 1|);
+ is($x->[0], 0, q|$x->[0] = 0|);
}
# done
diff --git a/cpan/Math-BigInt/t/bigintpm.inc b/cpan/Math-BigInt/t/bigintpm.inc
index 82168d03fb..ad7322c203 100644
--- a/cpan/Math-BigInt/t/bigintpm.inc
+++ b/cpan/Math-BigInt/t/bigintpm.inc
@@ -1,357 +1,427 @@
#include this file into another for subclass testing
-my $version = ${"$class\::VERSION"};
-
use strict;
+use warnings;
+
+our ($CLASS, $CALC);
##############################################################################
# for testing inheritance of _swap
package Math::Foo;
-use Math::BigInt lib => $main::CL;
-use vars qw/@ISA/;
-@ISA = (qw/Math::BigInt/);
+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] );
+ # 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;
-my $CALC = $class->config()->{lib}; is ($CALC,$CL);
+is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}");
-my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class);
+my ($x, $y, $z, @args, $try, $got, $want);
+my ($f, $round_mode, $expected_class);
-while (<DATA>)
- {
- $_ =~ s/[\n\r]//g; # remove newlines
- next if /^#/; # skip comments
- if (s/^&//)
- {
- $f = $_; next;
+while (<DATA>) {
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
+
+ my ($m, $e);
+
+ if (s/^&//) {
+ $f = $_;
+ next;
}
- elsif (/^\$/)
- {
- $round_mode = $_; $round_mode =~ s/^\$/$class\->/; next;
+
+ if (/^\$/) {
+ $round_mode = $_;
+ $round_mode =~ s/^\$/$CLASS\->/;
+ next;
}
- @args = split(/:/,$_,99); $ans = pop(@args);
- $expected_class = $class;
- if ($ans =~ /(.*?)=(.*)/)
- {
- $expected_class = $2; $ans = $1;
+ @args = split(/:/, $_, 99);
+ $want = pop(@args);
+ $expected_class = $CLASS;
+
+ if ($want =~ /(.*?)=(.*)/) {
+ $expected_class = $2;
+ $want = $1;
}
- $try = "\$x = $class->new(\"$args[0]\");";
- if ($f eq "bnorm")
- {
- $try = "\$x = $class->bnorm(\"$args[0]\");";
- # some is_xxx tests
- } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
- $try .= "\$x->$f() || 0;";
- } 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|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|as_hex|as_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 ops
- $try .= "\$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 + $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 .= " \$z = $class->new('$args[2]'); ";
- }
- $try .= "$class\::bgcd(\$x, \$y";
- $try .= ", \$z" if (defined $args[2]);
- $try .= " );";
+
+ $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|as_hex|as_bin|as_oct)$/) {
+ $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 + $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 "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'";
+ }
}
- elsif ($f eq "blcm")
- {
- if (defined $args[2])
- {
- $try .= " \$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 .= "\$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
-
- $ans1 = eval $try;
- # convert hex/binary targets to decimal
- if ($ans =~ /^(0x0x|0b0b)/)
- {
- $ans =~ s/^0[xb]//; $ans = Math::BigInt->new($ans)->bstr();
- }
- if ($ans eq "")
- {
- is ($ans1, undef);
+ } # 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();
}
- else
- {
- # print "try: $try ans: $ans1 $ans\n";
- print "# Tried: '$try'\n" if !is ($ans1, $ans);
- is (ref($ans),$expected_class) if $expected_class ne $class;
+ 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($ans1,$f) if ref $ans1;
- } # endwhile data tests
+ # check internal state of number objects
+ is_valid($got, $f) if ref $got;
+} # endwhile data tests
close DATA;
-# test some more
-@a = ();
-for (my $i = 1; $i < 10; $i++)
- {
- push @a, $i;
- }
-is("@a", "1 2 3 4 5 6 7 8 9");
-
# test whether self-multiplication works correctly (result is 2**64)
-$try = "\$x = $class->new('4294967296');";
-$try .= '$a = $x->bmul($x);';
-$ans1 = eval $try;
-print "# Tried: '$try'\n" if !is ($ans1, $class->new(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 = "\$x = $class->new(10);";
-$try .= '$a = $x->bpow($x);';
-$ans1 = eval $try;
-print "# Tried: '$try'\n" if !is ($ans1, $class->new(10) ** 10);
+$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);
+$x = $CLASS->new(3);
+$y = $CLASS->new(4);
$z = $x & $y;
-is ($x,3);
-is ($y,4);
-is ($z,0);
+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);
-is ($y,4);
-is ($z,7);
-$x = $class->new(1);
-$y = $class->new(2);
+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);
-is ($y,2);
-is ($z,3);
+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);
+$x = $CLASS->new(5);
+$y = $CLASS->new(4);
$z = $x ^ $y;
-is ($x,5);
-is ($y,4);
-is ($z,1);
-
-$x = $class->new(-5); $y = -$x;
-is ($x, -5);
-
-$x = $class->new(-5); $y = abs($x);
-is ($x, -5);
-
-$x = $class->new(8);
-$y = $class->new(-1);
-$z = $class->new(5033);
-my $u = $x->copy()->bmodpow($y,$z);
-is ($u,4404);
-is ($y,-1);
-is ($z,5033);
-
-$x = $class->new(-5); $y = -$x; is ($x,-5); is ($y,5);
-$x = $class->new(-5); $y = $x->copy()->bneg(); is ($x,-5); is ($y,5);
-
-$x = $class->new(-5); $y = $class->new(3); $x->bmul($y); is ($x,-15); is ($y,3);
-$x = $class->new(-5); $y = $class->new(3); $x->badd($y); is ($x,-2); is ($y,3);
-$x = $class->new(-5); $y = $class->new(3); $x->bsub($y); is ($x,-8); is ($y,3);
-$x = $class->new(-15); $y = $class->new(3); $x->bdiv($y); is ($x,-5); is ($y,3);
-$x = $class->new(-5); $y = $class->new(3); $x->bmod($y); is ($x,1); is ($y,3);
-
-$x = $class->new(5); $y = $class->new(3); $x->bmul($y); is ($x,15); is ($y,3);
-$x = $class->new(5); $y = $class->new(3); $x->badd($y); is ($x,8); is ($y,3);
-$x = $class->new(5); $y = $class->new(3); $x->bsub($y); is ($x,2); is ($y,3);
-$x = $class->new(15); $y = $class->new(3); $x->bdiv($y); is ($x,5); is ($y,3);
-$x = $class->new(5); $y = $class->new(3); $x->bmod($y); is ($x,2); is ($y,3);
-
-$x = $class->new(5); $y = $class->new(-3); $x->bmul($y); is ($x,-15); is ($y,-3);
-$x = $class->new(5); $y = $class->new(-3); $x->badd($y); is ($x,2); is ($y,-3);
-$x = $class->new(5); $y = $class->new(-3); $x->bsub($y); is ($x,8); is ($y,-3);
-$x = $class->new(15); $y = $class->new(-3); $x->bdiv($y); is ($x,-5); is ($y,-3);
-$x = $class->new(5); $y = $class->new(-3); $x->bmod($y); is ($x,-1); is ($y,-3);
+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 .= "'false' if \$x ne \$y;";
-$ans = eval $try;
-print "# For '$try'\n" if (!is ("$ans" , "false") );
+$try = '$x = $CLASS->new(0);';
+$try .= ' $y = 10;';
+$try .= ' $x ne $y;';
+$want = eval $try;
+ok($want, "overloading cmp works");
-# we cant 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
+# 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;";
-$try .= "'ok' if \$x == 1024;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS->new(10); \$x = 2 ** \$x; \$x == 1024;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class->new(10); \$x = 2 * \$x;";
-$try .= "'ok' if \$x == 20;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS->new(10); \$x = 2 * \$x; \$x == 20;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class->new(10); \$x = 2 + \$x;";
-$try .= "'ok' if \$x == 12;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS->new(10); \$x = 2 + \$x; \$x == 12;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(10); \$x = 2 - \$x;";
-$try .= "'ok' if \$x == -8;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(10); \$x = 2 - \$x; \$x == -8;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(10); \$x = 20 / \$x;";
-$try .= "'ok' if \$x == 2;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(10); \$x = 20 / \$x; \$x == 2;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(3); \$x = 20 % \$x;";
-$try .= "'ok' if \$x == 2;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(3); \$x = 20 % \$x; \$x == 2;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(7); \$x = 20 & \$x;";
-$try .= "'ok' if \$x == 4;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(7); \$x = 20 & \$x; \$x == 4;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(7); \$x = 0x20 | \$x;";
-$try .= "'ok' if \$x == 0x27;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(7); \$x = 0x20 | \$x; \$x == 0x27;";
+$want = eval $try;
+ok($want, $try);
-$try = "\$x = $class\->new(7); \$x = 0x20 ^ \$x;";
-$try .= "'ok' if \$x == 0x27;"; $ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->new(7); \$x = 0x20 ^ \$x; \$x == 0x27;";
+$want = eval $try;
+ok($want, $try);
###############################################################################
-# check badd(4,5) form
+# check badd(4, 5) form
-$try = "\$x = $class\->badd(4,5);";
-$try .= "'ok' if \$x == 9;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" );
+$try = "\$x = $CLASS\->badd(4, 5); \$x == 9;";
+$want = eval $try;
+ok($want, $try);
###############################################################################
# check undefs: NOT DONE YET
@@ -359,165 +429,228 @@ print "# For '$try'\n" if (!ok "$ans" , "ok" );
###############################################################################
# bool
-$x = $class->new(1); if ($x) { is (1,1); } else { is ($x,'to be true') }
-$x = $class->new(0); if (!$x) { is (1,1); } else { is ($x,'to be false') }
+$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); # $class, 4, 5
-like ($args[0], qr/^Math::BigInt/);
-is ($args[1],4);
-is ($args[2],5);
-
-@args = Math::BigInt::objectify(0,4,5);
-is (scalar @args,3); # $class, 4, 5
-like ($args[0], qr/^Math::BigInt/);
-is ($args[1],4);
-is ($args[2],5);
-
-@args = Math::BigInt::objectify(2,4,5);
-is (scalar @args,3); # $class, 4, 5
-like ($args[0], qr/^Math::BigInt/);
-is ($args[1],4);
-is ($args[2],5);
-
-@args = Math::BigInt::objectify(2,4,5,6,7);
-is (scalar @args,5); # $class, 4, 5, 6, 7
-like ($args[0], qr/^Math::BigInt/);
-is ($args[1],4); is (ref($args[1]),$args[0]);
-is ($args[2],5); is (ref($args[2]),$args[0]);
-is ($args[3],6); is (ref($args[3]),'');
-is ($args[4],7); is (ref($args[4]),'');
-
-@args = Math::BigInt::objectify(2,$class,4,5,6,7);
-is (scalar @args,5); # $class, 4, 5, 6, 7
-is ($args[0],$class);
-is ($args[1],4); is (ref($args[1]),$args[0]);
-is ($args[2],5); is (ref($args[2]),$args[0]);
-is ($args[3],6); is (ref($args[3]),'');
-is ($args[4],7); is (ref($args[4]),'');
+@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);
-is ($class->badd(123,321),444);
-is ($class->badd(123,$class->new(321)),444);
-
-is ($class->new(123)->bsub(122),1);
-is ($class->bsub(321,123),198);
-is ($class->bsub(321,$class->new(123)),198);
-
-is ($class->new(123)->bmul(123),15129);
-is ($class->bmul(123,123),15129);
-is ($class->bmul(123,$class->new(123)),15129);
-
-is ($class->new(15129)->bdiv(123),123);
-is ($class->bdiv(15129,123),123);
-is ($class->bdiv(15129,$class->new(123)),123);
-
-is ($class->new(15131)->bmod(123),2);
-is ($class->bmod(15131,123),2);
-is ($class->bmod(15131,$class->new(123)),2);
-
-is ($class->new(2)->bpow(16),65536);
-is ($class->bpow(2,16),65536);
-is ($class->bpow(2,$class->new(16)),65536);
-
-is ($class->new(2**15)->brsft(1),2**14);
-is ($class->brsft(2**15,1),2**14);
-is ($class->brsft(2**15,$class->new(1)),2**14);
-
-is ($class->new(2**13)->blsft(1),2**14);
-is ($class->blsft(2**13,1),2**14);
-is ($class->blsft(2**13,$class->new(1)),2**14);
+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
+$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
-$x = $class->new($z); is ($x->bsstr(),'1e+129');
+$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);
- is ($class->new(" $c"),$m);
- is ($class->new("$c "),$m);
- is ($class->new(" $c "),$m);
- is ($class->new("\n$c"),$m);
- is ($class->new("$c\n"),$m);
- is ($class->new("\n$c\n"),$m);
- is ($class->new(" \n$c\n"),$m);
- is ($class->new(" \n$c \n"),$m);
- is ($class->new(" \n$c\n "),$m);
- is ($class->new(" \n$c\n1"),'NaN');
- is ($class->new("1 \n$c\n1"),'NaN');
- }
+# 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");
-is ($x->length(),length "20988936657440586486151264256610222593863921");
+# ((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");
+$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); is ($y,0);
+$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); is ($y,0);
+$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');
-my $y = $class->new('18');
-is ($x <<= $y, 2 << 18);
-is ($x, 2 << 18);
-is ($x >>= $y, 2);
-is ($x, 2);
+$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--;
+#$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);
+#$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);
-is (ref($x),'Math::Foo');
+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);
-is (ref($x),'Math::Foo');
+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"');
###############################################################################
# Check numify on non-finite objects.
@@ -526,17 +659,21 @@ is (ref($x),'Math::Foo');
require Math::Complex;
my $inf = Math::Complex::Inf();
my $nan = $inf - $inf;
- is($class -> binf("+") -> numify(), $inf, "numify of +Inf");
- is($class -> binf("-") -> numify(), -$inf, "numify of -Inf");
- is($class -> bnan() -> numify(), $nan, "numify of NaN");
+ is($CLASS -> binf("+") -> numify(), $inf, "numify of +Inf");
+ is($CLASS -> binf("-") -> numify(), -$inf, "numify of -Inf");
+ is($CLASS -> bnan() -> numify(), $nan, "numify of NaN");
}
###############################################################################
# Test whether +inf eq inf
-# This tried to test whether 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');
+#
+# 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
@@ -544,17 +681,18 @@ $x = $class->new('+inf'); is ($x,'inf');
require Config;
SKIP: {
skip("no 64 bit integer support", 4)
- unless $Config::Config{use64bitint} || $Config::Config{use64bitall};
+ if ! $Config::Config{use64bitint} || ! $Config::Config{use64bitall}
+ || $] <= 5.006002;
# The following should not give "1.84467440737096e+19".
- $x = $class -> new(2) -> bpow(64) -> bdec();
+ $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();
+ $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");
};
@@ -572,135 +710,219 @@ SKIP: {
###########################################################################
# check proper length of internal arrays
- my $bl = $CL->_base_len();
+ my $bl = $CALC->_base_len();
my $BASE = '9' x $bl;
my $MAX = $BASE;
$BASE++;
- $x = $class->new($MAX); is_valid($x); # f.i. 9999
- $x += 1; is ($x,$BASE); is_valid($x); # 10000
- $x -= 1; is ($x,$MAX); is_valid($x); # 9999 again
+ # 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);
- $x = $class->new(-($BASE-1)); is ($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 aaaarglburblll...)
- $x = $class->new($BASE); is ($x->numify()+0,$BASE+0);
- $x = $class->new(-$BASE); is ($x->numify(),-$BASE);
- $x = $class->new( -($BASE*$BASE*1+$BASE*1+1) );
- is ($x->numify(),-($BASE*$BASE*1+$BASE*1+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
+ # 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++;
- if ($x > $BASE) { is (1,1) } else { is ("$x < $BASE","$x > $BASE"); }
+ $x = $CLASS->new($BASE - 2);
+ $x++;
+ $x++;
+ $x++;
+ $x++;
+ ok($x > $BASE, '$x > $BASE');
- $x = $class->new($BASE+3); $x++;
- if ($x > $BASE) { is (1,1) } else { is ("$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));
+ # 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
+ # test bug that $CLASS->digit($string) did not work
- is ($class->digit(123,2),1);
+ 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);
- is ($x, 23456);
+ $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 = $CL->_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);
-
-
- #########################################################################
- # 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');
+ 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');
+ $x = $CLASS->new('-322056000');
+ ($x, $y) = $x->bdiv('-12882240');
- is ($y,'0'); is_valid($y); # $y not '-0'
+ 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);
+ $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);
- is ($class->bone(),1);
- is ($class->bone('+'),1);
- is ($class->bone('-'),-1);
- is ($class->bnan(),'NaN');
- is ($class->binf(),'inf');
- is ($class->binf('+'),'inf');
- is ($class->binf('-'),'-inf');
- is ($class->binf('-inf'),'-inf');
+ 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_one("-")
- is ($class->new(1)->is_one('-'),0);
- is ($class->new(-1)->is_one('-'),1);
- is ($class->new(1)->is_one(),1);
- is ($class->new(-1)->is_one(),0);
+ 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);
- $x = $class->new(-3); $x -= $x; is ($x, 0);
- $x = $class->new('NaN'); $x -= $x; is ($x->is_nan(), 1);
- $x = $class->new('inf'); $x -= $x; is ($x->is_nan(), 1);
- $x = $class->new('-inf'); $x -= $x; is ($x->is_nan(), 1);
-
- $x = $class->new('NaN'); $x += $x; is ($x->is_nan(), 1);
- $x = $class->new('inf'); $x += $x; is ($x->is_inf(), 1);
- $x = $class->new('-inf'); $x += $x; is ($x->is_inf('-'), 1);
- $x = $class->new(3); $x += $x; is ($x, 6);
- $x = $class->new(-3); $x += $x; is ($x, -6);
-
- $x = $class->new(3); $x *= $x; is ($x, 9);
- $x = $class->new(-3); $x *= $x; is ($x, 9);
- $x = $class->new(3); $x /= $x; is ($x, 1);
- $x = $class->new(-3); $x /= $x; is ($x, 1);
- $x = $class->new(3); $x %= $x; is ($x, 0);
- $x = $class->new(-3); $x %= $x; is ($x, 0);
+ $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,
+ qq|\$x = $CLASS->new("NaN"); \$x += \$x; \$x->is_nan() = 1|);
+
+ $x = $CLASS->new("inf");
+ $x += $x;
+ is($x->is_inf(), 1,
+ qq|\$x = $CLASS->new("inf"); \$x += \$x; \$x->is_inf() = 1|);
+
+ $x = $CLASS->new("-inf");
+ $x += $x;
+ is($x->is_inf("-"), 1,
+ qq|\$x = $CLASS->new("-inf"); \$x += \$x; \$x->is_inf("-") = 1|);
+
+ $x = $CLASS->new(3);
+ $x += $x;
+ is($x, 6, qq|\$x = $CLASS->new(3); \$x += \$x; \$x = 6|);
+
+ $x = $CLASS->new(-3);
+ $x += $x;
+ is($x, -6, qq|\$x = $CLASS->new(-3); \$x += \$x; \$x = -6|);
+
+ $x = $CLASS->new(3);
+ $x *= $x;
+ is($x, 9, qq|\$x = $CLASS->new(3); \$x *= \$x; \$x = 9|);
+
+ $x = $CLASS->new(-3);
+ $x *= $x;
+ is($x, 9, qq|\$x = $CLASS->new(-3); \$x *= \$x; \$x = 9|);
+
+ $x = $CLASS->new(3);
+ $x /= $x;
+ is($x, 1, qq|\$x = $CLASS->new(3); \$x /= \$x; \$x = 1|);
+
+ $x = $CLASS->new(-3);
+ $x /= $x;
+ is($x, 1, qq|\$x = $CLASS->new(-3); \$x /= \$x; \$x = 1|);
+
+ $x = $CLASS->new(3);
+ $x %= $x;
+ is($x, 0, qq|\$x = $CLASS->new(3); \$x %= \$x; \$x = 0|);
+
+ $x = $CLASS->new(-3);
+ $x %= $x;
+ is($x, 0, qq|\$x = $CLASS->new(-3); \$x %= \$x; \$x = 0|);
}
###############################################################################
@@ -709,60 +931,72 @@ SKIP: {
1;
###############################################################################
-# sub to check validity of a BigInt internally, to ensure that no op leaves a
-# number object in an invalid state (f.i. "-0")
+# sub to check validity of a Math::BigInt internally, to ensure that no op
+# leaves a number object in an invalid state (f.i. "-0")
-sub is_valid
- {
- my ($x,$f) = @_;
+sub is_valid {
+ my ($x, $f) = @_;
- my $e = 0; # error?
+ my $e = 0; # error?
- # allow the check to pass for all Lite, and all MBI and subclasses
- # ok as reference?
- $e = 'Not a reference to Math::BigInt' if ref($x) !~ /^Math::BigInt/;
+ # allow the check to pass for all Lite, and all MBI and subclasses
+ # ok as reference?
+ $e = 'Not a reference to Math::BigInt' if ref($x) !~ /^Math::BigInt/;
- if (ref($x) ne 'Math::BigInt::Lite')
- {
- # has ok sign?
- $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
- if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
-
- $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
- $e = $CALC->_check($x->{value}) if $e eq '0';
+ if (ref($x) ne 'Math::BigInt::Lite') {
+ # has ok sign?
+ $e = qq|Illegal sign $x->{sign}|
+ . qq| (expected: "+", "-", "-inf", "+inf" or "NaN"|
+ if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+
+ $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
+ $e = $CALC->_check($x->{value}) if $e eq '0';
}
- # test done, see if error did crop up
- is (1,1), return if ($e eq '0');
+ # test done, see if error did crop up
+ if ($e eq '0') {
+ pass('is a valid object');
+ return;
+ }
- is (1,$e." after op '$f'");
- }
+ fail($e . " after op '$f'");
+}
__DATA__
+
&.=
1234:-345:1234-345
+
&+=
1:2:3
-1:-2:-3
+
&-=
1:2:-1
-1:-2:1
+
&*=
2:3:6
-1:5:-5
+
&%=
100:3:1
8:9:8
-629:5033:4404
+
&/=
100:3:33
-8:2:-4
+
&|=
2:1:3
+
&&=
5:7:5
+
&^=
5:7:2
+
&blog
#
NaNlog:2:NaN
@@ -830,6 +1064,7 @@ inf:inf:NaN
3:4:0
# $x == 1 => result 0
1:5:0
+
&is_negative
0:0
-1:1
@@ -837,6 +1072,7 @@ inf:inf:NaN
+inf:0
-inf:1
NaNneg:0
+
&is_positive
0:0
-1:0
@@ -844,6 +1080,7 @@ NaNneg:0
+inf:1
-inf:0
NaNneg:0
+
&is_int
-inf:0
+inf:0
@@ -851,6 +1088,7 @@ NaNis_int:0
1:1
0:1
123e12:1
+
&is_odd
abc:0
0:0
@@ -863,6 +1101,7 @@ abc:0
2:0
120:0
121:1
+
&is_even
abc:0
0:1
@@ -875,6 +1114,7 @@ abc:0
2:1
120:1
121:0
+
&bacmp
+0:-0:0
+0:+1:-1
@@ -909,12 +1149,20 @@ acmpNaN:acmpNaN:
NaN:inf:
-inf:NaN:
NaN:-inf:
+
&bnorm
0e999:0
0e-999:0
-0e999:0
-0e-999:0
123:123
+123.000:123
+123e0:123
+123e+0:123
+123e-0:123
+123.000e0:123
+123.000e+0:123
+123.000e-0:123
# binary input
0babc:NaN
0b123:NaN
@@ -1004,7 +1252,8 @@ NaN:-inf:
0x200000001:8589934593
0x400000001:17179869185
0x800000001:34359738369
-# bug found by Mark Lakata in Calc.pm creating too big one-element numbers in _from_hex()
+# bug found by Mark Lakata in Calc.pm creating too big one-element numbers
+# in _from_hex()
0x2dd59e18a125dbed30a6ab1d93e9c855569f44f75806f0645dc9a2e98b808c3:1295719234436071846486578237372801883390756472611551858964079371952886122691
# inf input
inf:inf
@@ -1134,10 +1383,12 @@ E23:NaN
-1.01E-1:NaN
1E-999999:NaN
0.5:NaN
+
&bnan
1:NaN
2:NaN
abc:NaN
+
&bone
2:+:1
2:-:-1
@@ -1145,15 +1396,18 @@ boneNaN:-:-1
boneNaN:+:1
2:abc:1
3::1
+
&binf
1:+:inf
2:-:-inf
3:abc:inf
+
&is_nan
123:0
abc:1
NaN:1
-123:0
+
&is_inf
+inf::1
-inf::1
@@ -1169,9 +1423,9 @@ NaN::0
-inf:+inf:0
+inf:-inf:0
+inf:+inf:1
-# it must be exactly /^[+-]inf$/
-+infinity::0
--infinity::0
++iNfInItY::1
+-InFiNiTy::1
+
&blsft
abc:abc:NaN
+2:+2:8
@@ -1190,6 +1444,7 @@ abc:abc:NaN
-5:1:2:-10
-2:1:2:-4
-102533203:1:2:-205066406
+
&brsft
abc:abc:NaN
+8:+2:2
@@ -1229,6 +1484,7 @@ abc:abc:NaN
-1640531254:1:2:-820265627
-820265627:1:2:-410132814
-205066405:1:2:-102533203
+
&bsstr
+inf:inf
-inf:-inf
@@ -1238,11 +1494,13 @@ abc:abc:NaN
bsstrabc:NaN
-5:-5e+0
-100:-1e+2
+
&numify
5:5
-5:-5
100:100
-100:-100
+
&bneg
bnegNaN:NaN
+inf:-inf
@@ -1253,6 +1511,7 @@ abd:NaN
-1:1
+123456789:-123456789
-123456789:123456789
+
&babs
babsNaN:NaN
+inf:inf
@@ -1262,6 +1521,7 @@ babsNaN:NaN
-1:1
+123456789:123456789
-123456789:123456789
+
&bsgn
NaN:NaN
+inf:1
@@ -1269,6 +1529,7 @@ NaN:NaN
0:0
+123456789:1
-123456789:-1
+
&bcmp
bcmpNaN:bcmpNaN:
bcmpNaN:0:
@@ -1313,6 +1574,7 @@ bcmpNaN:0:
NaN:inf:
-inf:NaN:
NaN:-inf:
+
&binc
abc:NaN
+inf:inf
@@ -1320,6 +1582,7 @@ abc:NaN
+0:1
+1:2
-1:0
+
&bdec
abc:NaN
+inf:inf
@@ -1327,6 +1590,7 @@ abc:NaN
+0:-1
+1:0
-1:-2
+
&badd
abc:abc:NaN
abc:0:NaN
@@ -1393,6 +1657,7 @@ baddNaN:+inf:NaN
-1:-100000000001:-100000000002
-1:-1000000000001:-1000000000002
-1:-10000000000001:-10000000000002
+
&bsub
abc:abc:NaN
abc:+0:NaN
@@ -1455,6 +1720,7 @@ abc:+0:NaN
100000000001:-1:100000000002
1000000000001:-1:1000000000002
10000000000001:-1:10000000000002
+
&bmuladd
abc:abc:0:NaN
abc:+0:0:NaN
@@ -1515,6 +1781,7 @@ NaNmul:-inf:0:NaN
3:-4:5:-7
9999999999999999999:10000000000000000000:1234567890:99999999999999999990000000001234567890
2:3:12345678901234567890:12345678901234567896
+
&bmul
abc:abc:NaN
abc:+0:NaN
@@ -1575,6 +1842,7 @@ NaNmul:-inf:NaN
99999999999999999:100000000000000000:9999999999999999900000000000000000
999999999999999999:1000000000000000000:999999999999999999000000000000000000
9999999999999999999:10000000000000000000:99999999999999999990000000000000000000
+
&bdiv-list
100:20:5,0
4095:4095:1,0
@@ -1646,6 +1914,7 @@ inf:0:inf,inf
9999999_9999999_9999999_9999999:100_0000000_0000000_0000000:99999,99999999999999999999999
9999999_9999999_9999999_9999999:10_0000000_0000000_0000000:999999,9999999999999999999999
9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999,999999999999999999999
+
&bdiv
abc:abc:NaN
abc:1:NaN
@@ -1763,6 +2032,7 @@ inf:0:inf
9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999
# bug with shortcut in Calc 0.44
949418181818187070707070707070707070:181818181853535353535353535353535353:5
+
&bmodinv
# format: number:modulus:result
# bmodinv Data errors
@@ -1804,6 +2074,7 @@ inf:5:NaN
5:inf:NaN
-inf:5:NaN
5:-inf:NaN
+
&bmodpow
# format: number:exponent:modulus:result
# bmodpow Data errors
@@ -1975,6 +2246,7 @@ abc:5:5:NaN
# bmodpow Error cases
inf:5:13:NaN
5:inf:13:NaN
+
&bmod
# inf handling, see table in doc
0:inf:0
@@ -2077,9 +2349,10 @@ abc:1:abc:NaN
# bug in bmod() not modifying the variable in place
-629:5033:4404
# bug in bmod() in Calc in the _div_use_div() shortcut code path,
-# when X == X and X was big
+# when X == X and X was big
111111111111111111111111111111:111111111111111111111111111111:0
12345678901234567890:12345678901234567890:0
+
&bgcd
inf:12:NaN
-inf:12:NaN
@@ -2107,6 +2380,7 @@ abc:+0:NaN
1034:804:2
27:90:56:1
27:90:54:9
+
&blcm
abc:abc:NaN
abc:+0:NaN
@@ -2116,6 +2390,7 @@ abc:+0:NaN
+0:+1:0
+27:+90:270
+1034:+804:415668
+
&band
abc:abc:NaN
abc:0:NaN
@@ -2153,6 +2428,7 @@ abc:0:NaN
0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F
+
&bior
abc:abc:NaN
abc:0:NaN
@@ -2204,6 +2480,7 @@ abc:0:NaN
0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+
&bxor
abc:abc:NaN
abc:0:NaN
@@ -2255,6 +2532,7 @@ abc:0:NaN
0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0
0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0
0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+
&bnot
abc:NaN
+0:-1
@@ -2263,6 +2541,7 @@ abc:NaN
-1:0
-2:1
-12:11
+
&digit
0:0:0
12:0:2
@@ -2285,6 +2564,7 @@ abc:NaN
100000:-3:0
100000:0:0
100000:1:0
+
&mantissa
abc:NaN
1e4:1
@@ -2294,6 +2574,7 @@ abc:NaN
-2:-2
+inf:inf
-inf:-inf
+
&exponent
abc:NaN
1e4:4
@@ -2304,6 +2585,7 @@ abc:NaN
0:0
+inf:inf
-inf:inf
+
&parts
abc:NaN,NaN
1e4:1,4
@@ -2314,6 +2596,7 @@ abc:NaN,NaN
0:0,0
+inf:inf,inf
-inf:-inf,inf
+
&bfac
-1:NaN
NaNfac:NaN
@@ -2335,6 +2618,7 @@ NaNfac:NaN
20:2432902008176640000
22:1124000727777607680000
69:171122452428141311372468338881272839092270544893520369393648040923257279754140647424000000000000000
+
&bpow
abc:12:NaN
12:abc:NaN
@@ -2419,6 +2703,7 @@ inf:-inf:NaN
-3:3:-27
-3:4:81
-3:5:-243
+
&length
100:3
10:2
@@ -2428,6 +2713,7 @@ inf:-inf:NaN
10000000000000000:17
-123:3
215960156869840440586892398248:30
+
&broot
# sqrt()
+0:2:0
@@ -2484,6 +2770,7 @@ NaN:inf:NaN
18446744073709551616:128:1
# 213 ** 15
84274086103068221283760416414557757:15:213
+
# see t/bigroot.t for more tests
&bsqrt
145:12
@@ -2514,12 +2801,14 @@ NaN:inf:NaN
Nan:NaN
+inf:inf
-inf:NaN
+
# see t/biglog.t for more tests
&bexp
NaN:NaN
inf:inf
1:2
2:7
+
&batan2
NaN:1:10:NaN
NaN:NaN:10:NaN
@@ -2550,10 +2839,12 @@ inf:+inf:14:0
-1:8:14:0
1:8:14:0
-1:1:14:0
+
&bpi
77:3
+0:3
11:3
+
# see t/bignok.t for more tests
&bnok
+inf:10:inf
@@ -2574,8 +2865,9 @@ NaN:1:NaN
2:0:1
7:0:1
2:1:2
+
&bround
-$round_mode('trunc')
+$round_mode("trunc")
0:12:0
NaNbround:12:NaN
+inf:12:inf
@@ -2593,7 +2885,7 @@ NaNbround:12:NaN
-101234500:6:-101234000
#+101234500:-4:101234000
#-101234500:-4:-101234000
-$round_mode('zero')
+$round_mode("zero")
+20123456789:5:20123000000
-20123456789:5:-20123000000
+20123456789:9:20123456800
@@ -2604,7 +2896,7 @@ $round_mode('zero')
#-201234500:-4:-201234000
+12345000:4:12340000
-12345000:4:-12340000
-$round_mode('+inf')
+$round_mode("+inf")
+30123456789:5:30123000000
-30123456789:5:-30123000000
+30123456789:9:30123456800
@@ -2615,7 +2907,7 @@ $round_mode('+inf')
#-301234500:-4:-301234000
+12345000:4:12350000
-12345000:4:-12340000
-$round_mode('-inf')
+$round_mode("-inf")
+40123456789:5:40123000000
-40123456789:5:-40123000000
+40123456789:9:40123456800
@@ -2626,7 +2918,7 @@ $round_mode('-inf')
#-401234500:-4:-401235000
+12345000:4:12340000
-12345000:4:-12350000
-$round_mode('odd')
+$round_mode("odd")
+50123456789:5:50123000000
-50123456789:5:-50123000000
+50123456789:9:50123456800
@@ -2637,7 +2929,7 @@ $round_mode('odd')
#-501234500:-4:-501235000
+12345000:4:12350000
-12345000:4:-12350000
-$round_mode('even')
+$round_mode("even")
+60123456789:5:60123000000
-60123456789:5:-60123000000
+60123456789:9:60123456800
@@ -2654,7 +2946,7 @@ $round_mode('even')
+1234567:6:1234570
+12345000:4:12340000
-12345000:4:-12340000
-$round_mode('common')
+$round_mode("common")
+60123456789:5:60123000000
+60123199999:5:60123000000
+60123299999:5:60123000000
@@ -2675,6 +2967,7 @@ $round_mode('common')
-60123700000:5:-60124000000
-60123800000:5:-60124000000
-60123900000:5:-60124000000
+
&is_zero
0:1
NaNzero:0
@@ -2683,6 +2976,7 @@ NaNzero:0
123:0
-1:0
1:0
+
&is_one
0:0
NaNone:0
@@ -2692,6 +2986,7 @@ NaNone:0
2:0
-1:0
-2:0
+
# floor, ceil, and int are pretty pointless in integer space, but play safe
&bfloor
0:0
@@ -2703,6 +2998,7 @@ NaNfloor:NaN
2:2
3:3
abc:NaN
+
&bceil
NaNceil:NaN
+inf:inf
@@ -2713,6 +3009,7 @@ NaNceil:NaN
2:2
3:3
abc:NaN
+
&bint
NaN:NaN
+inf:inf
@@ -2722,6 +3019,7 @@ NaN:NaN
-2:-2
2:2
3:3
+
&as_hex
128:0x80
-128:-0x80
@@ -2732,6 +3030,7 @@ NaN:NaN
+inf:inf
-inf:-inf
NaNas_hex:NaN
+
&as_bin
128:0b10000000
-128:-0b10000000
@@ -2743,6 +3042,19 @@ NaNas_hex:NaN
+inf:inf
-inf:-inf
NaNas_bin:NaN
+
+&as_oct
+128:0200
+-128:-0200
+0:00
+-0:00
+1:01
+0b1010111101010101010110110110110110101:01275252666665
+0x123456789123456789:044321263611044321263611
++inf:inf
+-inf:-inf
+NaNas_oct:NaN
+
# overloaded functions
&log
-1:NaN
@@ -2755,11 +3067,19 @@ NaNas_bin:NaN
-inf:inf
inf:inf
NaN:NaN
+
&exp
+
&sin
+
&cos
+
&atan2
+
&int
+
&neg
+
&abs
+
&sqrt
diff --git a/cpan/Math-BigInt/t/bigintpm.t b/cpan/Math-BigInt/t/bigintpm.t
index b641adadd3..7c81c89d54 100644
--- a/cpan/Math-BigInt/t/bigintpm.t
+++ b/cpan/Math-BigInt/t/bigintpm.t
@@ -1,36 +1,47 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 3701 + 6;
+use warnings;
+
+use Test::More tests => 3724 # tests in require'd file
+ + 6; # tests in this file
use Math::BigInt lib => 'Calc';
-use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigInt";
-$CL = "Math::BigInt::Calc";
+our ($CLASS, $CALC);
+$CLASS = "Math::BigInt";
+$CALC = "Math::BigInt::Calc";
+
+my $x;
#############################################################################
# from_hex(), from_bin() and from_oct() tests
-my $x = Math::BigInt->from_hex('0xcafe');
-is ($x, "51966", 'from_hex() works');
-
+$x = Math::BigInt->from_hex('0xcafe');
+is($x, "51966",
+ qq|Math::BigInt->from_hex("0xcafe")|);
+
$x = Math::BigInt->from_hex('0xcafebabedead');
-is ($x, "223195403574957", 'from_hex() works with long numbers');
-
+is($x, "223195403574957",
+ qq|Math::BigInt->from_hex("0xcafebabedead")|);
+
$x = Math::BigInt->from_bin('0b1001');
-is ($x, "9", 'from_bin() works');
-
+is($x, "9",
+ qq|Math::BigInt->from_bin("0b1001")|);
+
$x = Math::BigInt->from_bin('0b1001100110011001100110011001');
-is ($x, "161061273", 'from_bin() works with big numbers');
+is($x, "161061273",
+ qq|Math::BigInt->from_bin("0b1001100110011001100110011001");|);
$x = Math::BigInt->from_oct('0775');
-is ($x, "509", 'from_oct() works');
-
+is($x, "509",
+ qq|Math::BigInt->from_oct("0775");|);
+
$x = Math::BigInt->from_oct('07777777777777711111111222222222');
-is ($x, "9903520314281112085086151826", 'from_oct() works with big numbers');
+is($x, "9903520314281112085086151826",
+ qq|Math::BigInt->from_oct("07777777777777711111111222222222");|);
#############################################################################
# all the other tests
-
-require 't/bigintpm.inc'; # all tests here for sharing
+
+require 't/bigintpm.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/bigints.t b/cpan/Math-BigInt/t/bigints.t
index a61696877b..1a08f255c5 100644
--- a/cpan/Math-BigInt/t/bigints.t
+++ b/cpan/Math-BigInt/t/bigints.t
@@ -1,99 +1,170 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 51;
+use warnings;
+use lib 't';
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 50;
# testing of Math::BigInt:Scalar (used by the testsuite),
# primarily for interface/api and not for the math functionality
use Math::BigInt::Scalar;
-my $C = 'Math::BigInt::Scalar'; # pass classname to sub's
+my $class = 'Math::BigInt::Scalar'; # pass classname to sub's
# _new and _str
-my $x = $C->_new("123"); my $y = $C->_new("321");
-is (ref($x),'SCALAR'); is ($C->_str($x),123); is ($C->_str($y),321);
+
+my $x = $class->_new("123");
+my $y = $class->_new("321");
+is(ref($x), 'SCALAR', 'ref($x)');
+is($class->_str($x), 123, "$class->_str(\$x)");
+is($class->_str($y), 321, "$class->_str(\$y)");
# _add, _sub, _mul, _div
-is ($C->_str($C->_add($x,$y)),444);
-is ($C->_str($C->_sub($x,$y)),123);
-is ($C->_str($C->_mul($x,$y)),39483);
-is ($C->_str($C->_div($x,$y)),123);
+is($class->_str($class->_add($x, $y)), 444,
+ "$class->_str($class->_add(\$x, \$y)");
+is($class->_str($class->_sub($x, $y)), 123,
+ "$class->_str($class->_sub(\$x, \$y)");
+is($class->_str($class->_mul($x, $y)), 39483,
+ "$class->_str($class->_mul(\$x, \$y))");
+is($class->_str($class->_div($x, $y)), 123,
+ "$class->_str($class->_div(\$x, \$y)");
+
+$class->_mul($x, $y);
+is($class->_str($x), 39483, "$class->_str(\$x)");
+is($class->_str($y), 321, "$class->_str(\$y)");
-is ($C->_str($C->_mul($x,$y)),39483);
-is ($C->_str($x),39483);
-is ($C->_str($y),321);
-my $z = $C->_new("2");
-is ($C->_str($C->_add($x,$z)),39485);
-my ($re,$rr) = $C->_div($x,$y);
+my $z = $class->_new("2");
+is($class->_str($class->_add($x, $z)), 39485,
+ "$class->_str($class->_add(\$x, \$z)");
-is ($C->_str($re),123); is ($C->_str($rr),2);
+my ($re, $rr) = $class->_div($x, $y);
+is($class->_str($re), 123, "$class->_str(\$re)");
+is($class->_str($rr), 2, "$class->_str(\$rr)");
# is_zero, _is_one, _one, _zero
-is ($C->_is_zero($x),0);
-is ($C->_is_one($x),0);
-is ($C->_is_one($C->_one()),1); is ($C->_is_one($C->_zero()),0);
-is ($C->_is_zero($C->_zero()),1); is ($C->_is_zero($C->_one()),0);
+is($class->_is_zero($x), 0, "$class->_is_zero($x)");
+is($class->_is_one($x), 0, "$class->_is_one($x)");
+
+is($class->_is_one($class->_one()), 1,
+ "$class->_is_one($class->_one())");
+is($class->_is_one($class->_zero()), 0,
+ "$class->_is_one($class->_zero())");
+is($class->_is_zero($class->_zero()), 1,
+ "$class->_is_zero($class->_zero())");
+is($class->_is_zero($class->_one()), 0,
+ "$class->_is_zero($class->_one())");
# is_odd, is_even
-is ($C->_is_odd($C->_one()),1); is ($C->_is_odd($C->_zero()),0);
-is ($C->_is_even($C->_one()),0); is ($C->_is_even($C->_zero()),1);
+
+is($class->_is_odd($class->_one()), 1,
+ "$class->_is_odd($class->_one())");
+is($class->_is_odd($class->_zero()), 0,
+ "$class->_is_odd($class->_zero())");
+is($class->_is_even($class->_one()), 0,
+ "$class->_is_even($class->_one())");
+is($class->_is_even($class->_zero()), 1,
+ "$class->_is_even($class->_zero())");
# _digit
-$x = $C->_new("123456789");
-is ($C->_digit($x,0),9);
-is ($C->_digit($x,1),8);
-is ($C->_digit($x,2),7);
-is ($C->_digit($x,-1),1);
-is ($C->_digit($x,-2),2);
-is ($C->_digit($x,-3),3);
+
+$x = $class->_new("123456789");
+is($class->_digit($x, 0), 9, "$class->_digit(\$x, 0)");
+is($class->_digit($x, 1), 8, "$class->_digit(\$x, 1)");
+is($class->_digit($x, 2), 7, "$class->_digit(\$x, 2)");
+is($class->_digit($x, -1), 1, "$class->_digit(\$x, -1)");
+is($class->_digit($x, -2), 2, "$class->_digit(\$x, -2)");
+is($class->_digit($x, -3), 3, "$class->_digit(\$x, -3)");
# _copy
-$x = $C->_new("12356");
-is ($C->_str($C->_copy($x)),12356);
+
+$x = $class->_new("12356");
+is($class->_str($class->_copy($x)), 12356,
+ "$class->_str($class->_copy(\$x))");
# _acmp
-$x = $C->_new("123456789");
-$y = $C->_new("987654321");
-is ($C->_acmp($x,$y),-1);
-is ($C->_acmp($y,$x),1);
-is ($C->_acmp($x,$x),0);
-is ($C->_acmp($y,$y),0);
+
+$x = $class->_new("123456789");
+$y = $class->_new("987654321");
+is($class->_acmp($x, $y), -1, "$class->_acmp(\$x, \$y)");
+is($class->_acmp($y, $x), 1, "$class->_acmp(\$y, \$x)");
+is($class->_acmp($x, $x), 0, "$class->_acmp(\$x, \$x)");
+is($class->_acmp($y, $y), 0, "$class->_acmp(\$y, \$y)");
# _div
-$x = $C->_new("3333"); $y = $C->_new("1111");
-is ($C->_str( scalar $C->_div($x,$y)),3);
-$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
-is ($C->_str($x),30); is ($C->_str($y),3);
-$x = $C->_new("123"); $y = $C->_new("1111");
-($x,$y) = $C->_div($x,$y); is ($C->_str($x),0); is ($C->_str($y),123);
+
+$x = $class->_new("3333");
+$y = $class->_new("1111");
+is($class->_str(scalar $class->_div($x, $y)), 3,
+ "$class->_str(scalar $class->_div(\$x, \$y))");
+
+$x = $class->_new("33333");
+$y = $class->_new("1111");
+($x, $y) = $class->_div($x, $y);
+is($class->_str($x), 30, "$class->_str(\$x)");
+is($class->_str($y), 3, "$class->_str(\$y)");
+
+$x = $class->_new("123");
+$y = $class->_new("1111");
+($x, $y) = $class->_div($x, $y);
+is($class->_str($x), 0, "$class->_str(\$x)");
+is($class->_str($y), 123, "$class->_str(\$y)");
# _num
-$x = $C->_new("12345"); $x = $C->_num($x); is (ref($x)||'',''); is ($x,12345);
+
+$x = $class->_new("12345");
+$x = $class->_num($x);
+is(ref($x) || '', '', 'ref($x) || ""');
+is($x, 12345, '$x');
# _len
-$x = $C->_new("12345"); $x = $C->_len($x); is (ref($x)||'',''); is ($x,5);
+
+$x = $class->_new("12345");
+$x = $class->_len($x);
+is(ref($x) || '', '', 'ref($x) || ""');
+is($x, 5, '$x');
# _and, _or, _xor
-$x = $C->_new("3"); $y = $C->_new("4"); is ($C->_str( $C->_or($x,$y)),7);
-$x = $C->_new("1"); $y = $C->_new("4"); is ($C->_str( $C->_xor($x,$y)),5);
-$x = $C->_new("7"); $y = $C->_new("3"); is ($C->_str( $C->_and($x,$y)),3);
+
+$x = $class->_new("3");
+$y = $class->_new("4");
+is($class->_str($class->_or($x, $y)), 7,
+ "$class->_str($class->_or($x, $y))");
+
+$x = $class->_new("1");
+$y = $class->_new("4");
+is($class->_str($class->_xor($x, $y)), 5,
+ "$class->_str($class->_xor($x, $y))");
+
+$x = $class->_new("7");
+$y = $class->_new("3");
+is($class->_str($class->_and($x, $y)), 3,
+ "$class->_str($class->_and($x, $y))");
# _pow
-$x = $C->_new("2"); $y = $C->_new("4"); is ($C->_str( $C->_pow($x,$y)),16);
-$x = $C->_new("2"); $y = $C->_new("5"); is ($C->_str( $C->_pow($x,$y)),32);
-$x = $C->_new("3"); $y = $C->_new("3"); is ($C->_str( $C->_pow($x,$y)),27);
+$x = $class->_new("2");
+$y = $class->_new("4");
+is($class->_str($class->_pow($x, $y)), 16,
+ "$class->_str($class->_pow($x, $y))");
-# _check
-$x = $C->_new("123456789");
-is ($C->_check($x),0);
-is ($C->_check(123),'123 is not a reference');
+$x = $class->_new("2");
+$y = $class->_new("5");
+is($class->_str($class->_pow($x, $y)), 32,
+ "$class->_str($class->_pow($x, $y))");
-# done
+$x = $class->_new("3");
+$y = $class->_new("3");
+is($class->_str($class->_pow($x, $y)), 27,
+ "$class->_str($class->_pow($x, $y))");
+
+# _check
-1;
+$x = $class->_new("123456789");
+is($class->_check($x), 0,
+ "$class->_check(\$x)");
+is($class->_check(123), '123 is not a reference',
+ "$class->_check(123)");
diff --git a/cpan/Math-BigInt/t/biglog.t b/cpan/Math-BigInt/t/biglog.t
index 94e8f7370c..4cc1447828 100644
--- a/cpan/Math-BigInt/t/biglog.t
+++ b/cpan/Math-BigInt/t/biglog.t
@@ -1,63 +1,69 @@
-#!/usr/bin/perl -w
+#!perl
# Test blog function (and bpow, since it uses blog), as well as bexp().
# It is too slow to be simple included in bigfltpm.inc, where it would get
-# executed 3 times. One time would be under BareCalc, which shouldn't make any
-# difference since there is no CALC->_log() function, and one time under a
-# subclass, which *should* work.
+# executed 3 times. One time would be under Math::BigInt::BareCalc, which
+# shouldn't make any difference since there is no CALC->_log() function, and
+# one time under a subclass, which *should* work.
# But it is better to test the numerical functionality, instead of not testing
# it at all (which did lead to wrong answers for 0 < $x < 1 in blog() in
# versions up to v1.63, and for bsqrt($x) when $x << 1 for instance).
use strict;
+use warnings;
+
use Test::More tests => 70;
use Math::BigFloat;
use Math::BigInt;
-my $cl = "Math::BigInt";
+my $class = "Math::BigInt";
#############################################################################
-# test $n->blog() in BigInt (broken until 1.80)
+# test $n->blog() in Math::BigInt (broken until 1.80)
-is ($cl->new(2)->blog(), '0', "blog(2)");
-is ($cl->new(288)->blog(), '5',"blog(288)");
-is ($cl->new(2000)->blog(), '7', "blog(2000)");
+is($class->new(2)->blog(), '0', "$class->new(2)->blog()");
+is($class->new(288)->blog(), '5', "$class->new(288)->blog()");
+is($class->new(2000)->blog(), '7', "$class->new(2000)->blog()");
#############################################################################
-# test $n->bexp() in BigInt
+# test $n->bexp() in Math::BigInt
-is ($cl->new(1)->bexp(), '2', "bexp(1)");
-is ($cl->new(2)->bexp(), '7',"bexp(2)");
-is ($cl->new(3)->bexp(), '20', "bexp(3)");
+is($class->new(1)->bexp(), '2', "$class->new(1)->bexp()");
+is($class->new(2)->bexp(), '7', "$class->new(2)->bexp()");
+is($class->new(3)->bexp(), '20', "$class->new(3)->bexp()");
#############################################################################
#############################################################################
-# BigFloat tests
+# Math::BigFloat tests
#############################################################################
# test $n->blog(undef, N) where N > 67 (broken until 1.82)
-$cl = "Math::BigFloat";
+$class = "Math::BigFloat";
-# These tests can take quite a while, but are nec. Maybe protect them with
-# some alarm()?
+# These tests can take quite a while, but are necessary. Maybe protect them
+# with some alarm()?
# this triggers the calculation and caching of ln(2):
-is ($cl->new(5)->blog(undef,71),
-'1.6094379124341003746007593332261876395256013542685177219126478914741790');
+is($class->new(5)->blog(undef, 71),
+ '1.6094379124341003746007593332261876395256013542685177219126478914741790',
+ "$class->new(5)->blog(undef, 71)");
# if the cache was correct, we should get this result, fast:
-is ($cl->new(2)->blog(undef,71),
-'0.69314718055994530941723212145817656807550013436025525412068000949339362');
+is($class->new(2)->blog(undef, 71),
+ '0.69314718055994530941723212145817656807550013436025525412068000949339362',
+ "$class->new(2)->blog(undef, 71)");
-is ($cl->new(11)->blog(undef,71),
-'2.3978952727983705440619435779651292998217068539374171752185677091305736');
+is($class->new(11)->blog(undef, 71),
+ '2.3978952727983705440619435779651292998217068539374171752185677091305736',
+ "$class->new(11)->blog(undef, 71)");
-is ($cl->new(21)->blog(undef,71),
-'3.0445224377234229965005979803657054342845752874046106401940844835750742');
+is($class->new(21)->blog(undef, 71),
+ '3.0445224377234229965005979803657054342845752874046106401940844835750742',
+ "$class->new(21)->blog(undef, 71)");
#############################################################################
@@ -65,112 +71,143 @@ is ($cl->new(21)->blog(undef,71),
# Don't attempt to run them with older versions. You are warned.
# $x < 0 => NaN
-is ($cl->new(-2)->blog(), 'NaN');
-is ($cl->new(-1)->blog(), 'NaN');
-is ($cl->new(-10)->blog(), 'NaN');
-is ($cl->new(-2,2)->blog(), 'NaN');
+is($class->new(-2)->blog(), 'NaN', "$class->new(-2)->blog()");
+is($class->new(-1)->blog(), 'NaN', "$class->new(-1)->blog()");
+is($class->new(-10)->blog(), 'NaN', "$class->new(-10)->blog()");
+is($class->new(-2, 2)->blog(), 'NaN', "$class->new(-2, 2)->blog()");
-my $ten = $cl->new(10)->blog();
+my $ten = $class->new(10)->blog();
# 10 is cached (up to 75 digits)
-is ($cl->new(10)->blog(), '2.302585092994045684017991454684364207601');
+is($class->new(10)->blog(),
+ '2.302585092994045684017991454684364207601',
+ qq|$class->new(10)->blog()|);
# 0.1 is using the cached value for log(10), too
-is ($cl->new(0.1)->blog(), -$ten);
-is ($cl->new(0.01)->blog(), -$ten * 2);
-is ($cl->new(0.001)->blog(), -$ten * 3);
-is ($cl->new(0.0001)->blog(), -$ten * 4);
+is($class->new("0.1")->blog(), -$ten,
+ qq|$class->new("0.1")->blog()|);
+is($class->new("0.01")->blog(), -$ten * 2,
+ qq|$class->new("0.01")->blog()|);
+is($class->new("0.001")->blog(), -$ten * 3,
+ qq|$class->new("0.001")->blog()|);
+is($class->new("0.0001")->blog(), -$ten * 4,
+ qq|$class->new("0.0001")->blog()|);
# also cached
-is ($cl->new(2)->blog(), '0.6931471805599453094172321214581765680755');
-is ($cl->new(4)->blog(), $cl->new(2)->blog * 2);
+is($class->new(2)->blog(),
+ '0.6931471805599453094172321214581765680755',
+ qq|$class->new(2)->blog()|);
+is($class->new(4)->blog(), $class->new(2)->blog * 2,
+ qq|$class->new(4)->blog()|);
# These are still slow, so do them only to 10 digits
-is ($cl->new('0.2')->blog(undef,10), '-1.609437912');
-is ($cl->new('0.3')->blog(undef,10), '-1.203972804');
-is ($cl->new('0.4')->blog(undef,10), '-0.9162907319');
-is ($cl->new('0.5')->blog(undef,10), '-0.6931471806');
-is ($cl->new('0.6')->blog(undef,10), '-0.5108256238');
-is ($cl->new('0.7')->blog(undef,10), '-0.3566749439');
-is ($cl->new('0.8')->blog(undef,10), '-0.2231435513');
-is ($cl->new('0.9')->blog(undef,10), '-0.1053605157');
-
-is ($cl->new('9')->blog(undef,10), '2.197224577');
-
-is ($cl->new('10')->blog(10,10), '1.000000000');
-is ($cl->new('20')->blog(20,10), '1.000000000');
-is ($cl->new('100')->blog(100,10), '1.000000000');
-
-is ($cl->new('100')->blog(10,10), '2.000000000'); # 10 ** 2 == 100
-is ($cl->new('400')->blog(20,10), '2.000000000'); # 20 ** 2 == 400
-
-is ($cl->new('4')->blog(2,10), '2.000000000'); # 2 ** 2 == 4
-is ($cl->new('16')->blog(2,10), '4.000000000'); # 2 ** 4 == 16
-
-is ($cl->new('1.2')->bpow('0.3',10), '1.056219968');
-is ($cl->new('10')->bpow('0.6',10), '3.981071706');
+is($class->new("0.2")->blog(undef, 10), "-1.609437912",
+ qq|$class->new("0.2")->blog(undef, 10)|);
+is($class->new("0.3")->blog(undef, 10), "-1.203972804",
+ qq|$class->new("0.3")->blog(undef, 10)|);
+is($class->new("0.4")->blog(undef, 10), "-0.9162907319",
+ qq|$class->new("0.4")->blog(undef, 10)|);
+is($class->new("0.5")->blog(undef, 10), "-0.6931471806",
+ qq|$class->new("0.5")->blog(undef, 10)|);
+is($class->new("0.6")->blog(undef, 10), "-0.5108256238",
+ qq|$class->new("0.6")->blog(undef, 10)|);
+is($class->new("0.7")->blog(undef, 10), "-0.3566749439",
+ qq|$class->new("0.7")->blog(undef, 10)|);
+is($class->new("0.8")->blog(undef, 10), "-0.2231435513",
+ qq|$class->new("0.8")->blog(undef, 10)|);
+is($class->new("0.9")->blog(undef, 10), "-0.1053605157",
+ qq|$class->new("0.9")->blog(undef, 10)|);
+
+is($class->new("9")->blog(undef, 10), "2.197224577",
+ qq|$class->new("9")->blog(undef, 10)|);
+
+is($class->new("10")->blog(10, 10), "1.000000000",
+ qq|$class->new("10")->blog(10, 10)|);
+is($class->new("20")->blog(20, 10), "1.000000000",
+ qq|$class->new("20")->blog(20, 10)|);
+is($class->new("100")->blog(100, 10), "1.000000000",
+ qq|$class->new("100")->blog(100, 10)|);
+
+is($class->new("100")->blog(10, 10), "2.000000000", # 10 ** 2 == 100
+ qq|$class->new("100")->blog(10, 10)|);
+is($class->new("400")->blog(20, 10), "2.000000000", # 20 ** 2 == 400
+ qq|$class->new("400")->blog(20, 10)|);
+
+is($class->new("4")->blog(2, 10), "2.000000000", # 2 ** 2 == 4
+ qq|$class->new("4")->blog(2, 10)|);
+is($class->new("16")->blog(2, 10), "4.000000000", # 2 ** 4 == 16
+ qq|$class->new("16")->blog(2, 10)|);
+
+is($class->new("1.2")->bpow("0.3", 10), "1.056219968",
+ qq|$class->new("1.2")->bpow("0.3", 10)|);
+is($class->new("10")->bpow("0.6", 10), "3.981071706",
+ qq|$class->new("10")->bpow("0.6", 10)|);
# blog should handle bigint input
-is (Math::BigFloat::blog(Math::BigInt->new(100),10), 2, "blog(100)");
+is(Math::BigFloat::blog(Math::BigInt->new(100), 10), 2, "blog(100)");
#############################################################################
# some integer results
-is ($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32");
-is ($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32");
-is ($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65");
+is($class->new(2)->bpow(32)->blog(2), "32", "2 ** 32");
+is($class->new(3)->bpow(32)->blog(3), "32", "3 ** 32");
+is($class->new(2)->bpow(65)->blog(2), "65", "2 ** 65");
-my $x = Math::BigInt->new( '777' ) ** 256;
-my $base = Math::BigInt->new( '12345678901234' );
-is ($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)');
+my $x = Math::BigInt->new('777') ** 256;
+my $base = Math::BigInt->new('12345678901234');
+is($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)');
-$x = Math::BigInt->new( '777' ) ** 777;
-$base = Math::BigInt->new( '777' );
-is ($x->copy()->blog($base), 777, 'blog(777**777, 777)');
+$x = Math::BigInt->new('777') ** 777;
+$base = Math::BigInt->new('777');
+is($x->copy()->blog($base), 777, 'blog(777**777, 777)');
#############################################################################
# test for bug in bsqrt() not taking negative _e into account
-test_bpow ('200','0.5',10, '14.14213562');
-test_bpow ('20','0.5',10, '4.472135955');
-test_bpow ('2','0.5',10, '1.414213562');
-test_bpow ('0.2','0.5',10, '0.4472135955');
-test_bpow ('0.02','0.5',10, '0.1414213562');
-test_bpow ('0.49','0.5',undef , '0.7');
-test_bpow ('0.49','0.5',10 , '0.7000000000');
-test_bpow ('0.002','0.5',10, '0.04472135955');
-test_bpow ('0.0002','0.5',10, '0.01414213562');
-test_bpow ('0.0049','0.5',undef,'0.07');
-test_bpow ('0.0049','0.5',10 , '0.07000000000');
-test_bpow ('0.000002','0.5',10, '0.001414213562');
-test_bpow ('0.021','0.5',10, '0.1449137675');
-test_bpow ('1.2','0.5',10, '1.095445115');
-test_bpow ('1.23','0.5',10, '1.109053651');
-test_bpow ('12.3','0.5',10, '3.507135583');
-
-test_bpow ('9.9','0.5',10, '3.146426545');
-test_bpow ('9.86902225','0.5',10, '3.141500000');
-test_bpow ('9.86902225','0.5',undef, '3.1415');
-
-test_bpow ('0.2','0.41',10, '0.5169187652');
+test_bpow ('200', '0.5', 10, '14.14213562');
+test_bpow ('20', '0.5', 10, '4.472135955');
+test_bpow ('2', '0.5', 10, '1.414213562');
+test_bpow ('0.2', '0.5', 10, '0.4472135955');
+test_bpow ('0.02', '0.5', 10, '0.1414213562');
+test_bpow ('0.49', '0.5', undef, '0.7');
+test_bpow ('0.49', '0.5', 10, '0.7000000000');
+test_bpow ('0.002', '0.5', 10, '0.04472135955');
+test_bpow ('0.0002', '0.5', 10, '0.01414213562');
+test_bpow ('0.0049', '0.5', undef, '0.07');
+test_bpow ('0.0049', '0.5', 10, '0.07000000000');
+test_bpow ('0.000002', '0.5', 10, '0.001414213562');
+test_bpow ('0.021', '0.5', 10, '0.1449137675');
+test_bpow ('1.2', '0.5', 10, '1.095445115');
+test_bpow ('1.23', '0.5', 10, '1.109053651');
+test_bpow ('12.3', '0.5', 10, '3.507135583');
+
+test_bpow ('9.9', '0.5', 10, '3.146426545');
+test_bpow ('9.86902225', '0.5', 10, '3.141500000');
+test_bpow ('9.86902225', '0.5', undef, '3.1415');
+
+test_bpow ('0.2', '0.41', 10, '0.5169187652');
#############################################################################
# test bexp() with cached results
-is ($cl->new(1)->bexp(), '2.718281828459045235360287471352662497757', 'bexp(1)');
-is ($cl->new(2)->bexp(40), $cl->new(1)->bexp(45)->bpow(2,40), 'bexp(2)');
+is($class->new(1)->bexp(), '2.718281828459045235360287471352662497757',
+ 'bexp(1)');
+is($class->new(2)->bexp(40), $class->new(1)->bexp(45)->bpow(2, 40),
+ 'bexp(2)');
-is ($cl->new("12.5")->bexp(61), $cl->new(1)->bexp(65)->bpow(12.5,61), 'bexp(12.5)');
+is($class->new("12.5")->bexp(61), $class->new(1)->bexp(65)->bpow(12.5, 61),
+ 'bexp(12.5)');
#############################################################################
# test bexp() with big values (non-cached)
-is ($cl->new(1)->bexp(100),
- '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427',
- 'bexp(100)');
+is($class->new(1)->bexp(100),
+ '2.7182818284590452353602874713526624977572470936999'
+ . '59574966967627724076630353547594571382178525166427',
+ 'bexp(100)');
-is ($cl->new("12.5")->bexp(91), $cl->new(1)->bexp(95)->bpow(12.5,91),
- 'bexp(12.5) to 91 digits');
+is($class->new("12.5")->bexp(91), $class->new(1)->bexp(95)->bpow(12.5, 91),
+ 'bexp(12.5) to 91 digits');
# all done
1;
@@ -178,10 +215,8 @@ is ($cl->new("12.5")->bexp(91), $cl->new(1)->bexp(95)->bpow(12.5,91),
#############################################################################
sub test_bpow
{
- my ($x,$y,$scale,$result) = @_;
+ my ($x, $y, $scale, $result) = @_;
- print "# Tried: $x->bpow($y,$scale);\n"
- unless ok ($cl->new($x)->bpow($y,$scale),$result);
+ print "# Tried: $x->bpow($y, $scale);\n"
+ unless ok($class->new($x)->bpow($y, $scale), $result);
}
-
-
diff --git a/cpan/Math-BigInt/t/bigroot.t b/cpan/Math-BigInt/t/bigroot.t
index 81532f9fab..9a6ab8a03d 100644
--- a/cpan/Math-BigInt/t/bigroot.t
+++ b/cpan/Math-BigInt/t/bigroot.t
@@ -8,38 +8,46 @@
# But it is better to test the numerical functionality, instead of not testing
# it at all.
-use strict; # restrict unsafe constructs
-use warnings; # enable optional warnings
+use strict; # restrict unsafe constructs
+use warnings; # enable optional warnings
use Test::More tests => 4 * 2;
use Math::BigFloat;
use Math::BigInt;
-my $cl = "Math::BigFloat";
-my $c = "Math::BigInt";
+my $mbf = "Math::BigFloat";
+my $mbi = "Math::BigInt";
-# 2 ** 240 =
+# 2 ** 240 =
# 1766847064778384329583297500742918515827483896875618958121606201292619776
# takes way too long
-#test_broot ('2','240', 8, undef, '1073741824');
-#test_broot ('2','240', 9, undef, '106528681.3099908308759836475139583940127');
-#test_broot ('2','120', 9, undef, '10321.27324073880096577298929482324664787');
-#test_broot ('2','120', 17, undef, '133.3268493632747279600707813049418888729');
-
-test_broot ('2','120', 8, undef, '32768');
-test_broot ('2','60', 8, undef, '181.0193359837561662466161566988413540569');
-test_broot ('2','60', 9, undef, '101.5936673259647663841091609134277286651');
-test_broot ('2','60', 17, undef, '11.54672461623965153271017217302844672562');
-
-sub test_broot
- {
- my ($x,$n,$y,$scale,$result) = @_;
-
- my $s = $scale || 'undef';
- is ($cl->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $cl $x->bpow($n)->broot($y,$s) == $result");
- $result =~ s/\..*//;
- is ($c->new($x)->bpow($n)->broot($y,$scale),$result, "Try: $c $x->bpow($n)->broot($y,$s) == $result");
- }
-
+#test_broot('2', '240', 8, undef,
+# '1073741824');
+#test_broot('2', '240', 9, undef,
+# '106528681.3099908308759836475139583940127');
+#test_broot('2', '120', 9, undef,
+# '10321.27324073880096577298929482324664787');
+#test_broot('2', '120', 17, undef,
+# '133.3268493632747279600707813049418888729');
+
+test_broot('2', '120', 8, undef,
+ '32768');
+test_broot('2', '60', 8, undef,
+ '181.0193359837561662466161566988413540569');
+test_broot('2', '60', 9, undef,
+ '101.5936673259647663841091609134277286651');
+test_broot('2', '60', 17, undef,
+ '11.54672461623965153271017217302844672562');
+
+sub test_broot {
+ my ($x, $n, $y, $scale, $expected) = @_;
+
+ my $s = $scale || 'undef';
+ is($mbf->new($x)->bpow($n)->broot($y, $scale), $expected,
+ "Try: $mbf->new($x)->bpow($n)->broot($y, $s) == $expected");
+ $expected =~ s/\..*//;
+ is($mbi->new($x)->bpow($n)->broot($y, $scale), $expected,
+ "Try: $mbi->new($x)->bpow($n)->broot($y, $s) == $expected");
+}
diff --git a/cpan/Math-BigInt/t/blog-mbf.t b/cpan/Math-BigInt/t/blog-mbf.t
deleted file mode 100644
index ec9e272be7..0000000000
--- a/cpan/Math-BigInt/t/blog-mbf.t
+++ /dev/null
@@ -1,264 +0,0 @@
-#!perl
-
-BEGIN {
- unless ($ENV{AUTHOR_TESTING}) {
- require Test::More;
- Test::More::plan(skip_all => 'these tests are for release candidate testing');
- }
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 139;
-use Scalar::Util qw< refaddr >;
-
-my $class;
-
-BEGIN { $class = 'Math::BigFloat'; }
-BEGIN { use_ok($class) }
-
-while (<DATA>) {
- s/\s+\z//;
- next if /^#/ || ! /\S/;
-
- # $in0 - the x value
- # $in1 - the base
- # $out0 - the wanted output value
- # $type - the type of the wanted number (real, non-real, ...)
- # $expr - mathematical expression of the wanted number
-
- my ($in0, $in1, $out0, $type, $expr) = split /:/;
-
- # Some of the test data use rational numbers.
- # - with Math::BigInt, we skip them
- # - with Math::BigFloat, we convert them to floats
- # - with Math::BigRat, we use them as they are
-
- $in0 = eval $in0 if $in0 =~ m|/|;
- $in1 = eval $in1 if $in1 =~ m|/|;
- $out0 = eval $out0 if $out0 =~ m|/|;
-
- my ($x, $y); # input values as objects
- my ($yo); # copy of input value
- my ($got); # test output
-
- my $test = qq|\$x = $class -> new("$in0"); | .
- qq|\$y = $class -> new("$in1"); | .
- qq|\$yo = \$y -> copy(); | .
- qq|\$got = \$x -> blog(\$y);|;
-
- my $desc = "logarithm of $in0 to base $in1";
-
- print("#\n",
- "# Now about to execute the following test.\n",
- "#\n",
- "# $test\n",
- "#\n");
-
- if ($in0 ne 'NaN' && $in1 ne 'NaN') {
- print("# Enter log($in1, $in0) into Wolfram Alpha",
- " (http://www.wolframalpha.com/), and it says that the result",
- " is ", length($type) ? $type : "real",
- length($expr) ? ": $expr" : "",
- ".", "\n",
- "#\n");
- }
-
- eval $test;
- die $@ if $@; # this should never happen
-
- subtest $desc, sub {
- plan tests => 5,
-
- # Check output.
-
- is(ref($got), $class, "output arg is a $class");
- is($got, $out0, 'output arg has the right value');
- is(refaddr($got), refaddr($x), 'output arg is the invocand');
-
- # The second argument (if the invocand is the first) shall *not* be
- # modified.
-
- is(ref($y), $class, "second input arg is still a $class");
- is_deeply($y, $yo, 'second output arg is unmodified');
-
- };
-
-}
-
-__END__
-
-# base = -inf
-
--inf:-inf:NaN:undefined:
--4:-inf:0::
--2:-inf:0::
--1:-inf:0::
--1/2:-inf:0::
-0:-inf:NaN:undefined:
-1/2:-inf:0::
-1:-inf:0::
-2:-inf:0::
-4:-inf:0::
-inf:-inf:NaN:undefined:
-NaN:-inf:NaN:undefined:
-
-# base = -4
-
--4:-4:1::
--2:-4:NaN:non-real and finite:(log(2)+i pi)/(log(4)+i pi)
-0:-4:NaN:non-real (directed) infinity:(-sqrt(pi^2+log^2(4))/(log(4)+i pi))infinity
-1/2:-4:NaN:non-real and finite:-(log(2))/(log(4)+i pi)
-1:-4:0::
-2:-4:NaN:non-real and finite:(log(2))/(log(4)+i pi)
-4:-4:NaN:non-real and finite:(log(4))/(log(4)+i pi)
-NaN:-4:NaN:undefined:
-
-# base = -2
-
--inf:-2:NaN:non-real (directed) infinity:sqrt(pi^2+log^2(2))/(log(2)+i pi)infinity
--4:-2:NaN:non-real and finite:(log(4)+i pi)/(log(2)+i pi)
--2:-2:1::
--1:-2:NaN:non-real and finite:(i pi)/(log(2)+i pi)
--1/2:-2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)+i pi)
-0:-2:NaN:complex infinity:
-1/2:-2:NaN:non-real and finite:-(log(2))/(log(2)+i pi)
-1:-2:0::
-2:-2:NaN:non-real and finite:(log(2))/(log(2)+i pi)
-4:-2:NaN:non-real and finite:(log(4))/(log(2)+i pi)
-inf:-2:NaN:non-real (directed) infinity:
-NaN:-2:NaN:undefined:
-
-# base = -1
-
--inf:-1:NaN:non-real (directed) infinity:
--4:-1:NaN:non-real and finite:-(i (log(4)+i pi))/pi
--2:-1:NaN:non-real and finite:-(i (log(2)+i pi))/pi
--1:-1:1::
--1/2:-1:NaN:non-real and finite:-(i (-log(2)+i pi))/pi
-0:-1:NaN:complex infinity:
-1:-1:0::
-1/2:-1:NaN:non-real and finite:(i log(2))/pi
-2:-1:NaN:non-real and finite:-(i log(2))/pi
-4:-1:NaN:non-real and finite:-(i log(4))/pi
-inf:-1:NaN:non-real (directed) infinity:
-NaN:-1:NaN:undefined:
-
-# base = -1/2
-
--inf:-1/2:NaN:non-real (directed) infinity:
--4:-1/2:NaN:non-real and finite:(log(4)+i pi)/(-log(2)+i pi)
--2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi)
--1:-1/2:NaN:non-real and finite:(i pi)/(-log(2)+i pi)
--1/2:-1/2:1::
-0:-1/2:NaN:complex infinity:
-1:-1/2:0::
-1/2:-1/2:NaN:non-real and finite:-(log(2))/(-log(2)+i pi)
-2:-1/2:NaN:non-real and finite:(log(2))/(-log(2)+i pi)
-4:-1/2:NaN:non-real and finite:(log(4))/(-log(2)+i pi)
-inf:-1/2:NaN:non-real (directed) infinity:
-NaN:-1/2:NaN:undefined:
-
-# base = 0
-
--inf:0:NaN:undefined:
--4:0:0::
--2:0:0::
--1:0:0::
--1/2:0:0::
-0:0:NaN:undefined:
-1/2:0:0::
-1:0:0::
-2:0:0::
-4:0:0::
-inf:0:NaN:undefined:
-NaN:0:NaN:undefined:
-
-# base = 1/2
-
--inf:1/2:-inf::
--2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi)
--1:1/2:NaN:non-real and finite:-(i pi)/(log(2))
--1/2:1/2:NaN:non-real and finite:-(-log(2)+i pi)/(log(2))
-0:1/2:inf::
-1/2:1/2:1::
-1:1/2:0::
-2:1/2:-1::
-inf:1/2:-inf::
-NaN:1/2:NaN:undefined:
-
-# base = 1
-
--inf:1:NaN:complex infinity:
--4:1:NaN:complex infinity:
--2:1:NaN:complex infinity:
--1:1:NaN:complex infinity:
--1/2:1:NaN:complex infinity:
-0:1:NaN:complex infinity:
-1/2:1:NaN:complex infinity:
-1:1:NaN:undefined:
-2:1:NaN:complex infinity:
-4:1:NaN:complex infinity:
-inf:1:NaN:complex infinity:
-NaN:1:NaN:undefined:
-
-# base = 2
-
--inf:2:inf::
--4:2:NaN:non-real and finite:(log(4)+i pi)/(log(2))
--2:2:NaN:non-real and finite:(log(2)+i pi)/(log(2))
--1:2:NaN:non-real and finite:(i pi)/(log(2))
--1/2:2:NaN:non-real and finite:(-log(2)+i pi)/(log(2))
-0:2:-inf::
-1/2:2:-1::
-1:2:0::
-2:2:1::
-4:2:2::
-4:4:1::
-inf:2:inf::
-NaN:2:NaN:undefined:
-
-# base = 4
-
--inf:4:inf::
--4:4:NaN:non-real and finite:(log(4)+i pi)/(log(4))
--2:4:NaN:non-real and finite:(log(2)+i pi)/(log(4))
--1/2:4:NaN:non-real and finite:(-log(2)+i pi)/(log(4))
-0:4:-inf::
-1:4:0::
-1/2:4:-1/2::
-2:4:1/2::
-4:4:1::
-inf:4:inf::
-NaN:4:NaN:undefined:
-
-# base = inf
-
--inf:inf:NaN:undefined:
--4:inf:0::
--2:inf:0::
--1:inf:0::
--1/2:inf:0::
-0:inf:NaN:undefined:
-1:inf:0::
-1/2:inf:0::
-2:inf:0::
-4:inf:0::
-inf:inf:NaN:undefined:
-NaN:inf:NaN:undefined:
-
-# base is NaN
-
--inf:NaN:NaN:undefined:
--4:NaN:NaN:undefined:
--2:NaN:NaN:undefined:
--1:NaN:NaN:undefined:
--1/2:NaN:NaN:undefined:
-0:NaN:NaN:undefined:
-1:NaN:NaN:undefined:
-1/2:NaN:NaN:undefined:
-2:NaN:NaN:undefined:
-4:NaN:NaN:undefined:
-inf:NaN:NaN:undefined:
-NaN:NaN:NaN:undefined:
diff --git a/cpan/Math-BigInt/t/blog-mbi.t b/cpan/Math-BigInt/t/blog-mbi.t
deleted file mode 100644
index 5ca48c695b..0000000000
--- a/cpan/Math-BigInt/t/blog-mbi.t
+++ /dev/null
@@ -1,264 +0,0 @@
-#!perl
-
-BEGIN {
- unless ($ENV{AUTHOR_TESTING}) {
- require Test::More;
- Test::More::plan(skip_all => 'these tests are for release candidate testing');
- }
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 97;
-use Scalar::Util qw< refaddr >;
-
-my $class;
-
-BEGIN { $class = 'Math::BigInt'; }
-BEGIN { use_ok($class) }
-
-while (<DATA>) {
- s/\s+\z//;
- next if /^#/ || ! /\S/;
-
- # $in0 - the x value
- # $in1 - the base
- # $out0 - the wanted output value
- # $type - the type of the wanted number (real, non-real, ...)
- # $expr - mathematical expression of the wanted number
-
- my ($in0, $in1, $out0, $type, $expr) = split /:/;
-
- # Some of the test data use rational numbers.
- # - with Math::BigInt, we skip them
- # - with Math::BigFloat, we convert them to floats
- # - with Math::BigRat, we use them as they are
-
- next if ($in0 =~ m|/| ||
- $in1 =~ m|/| ||
- $out0 =~ m|/|);
-
- my ($x, $y); # input values as objects
- my ($yo); # copy of input value
- my ($got); # test output
-
- my $test = qq|\$x = $class -> new("$in0"); | .
- qq|\$y = $class -> new("$in1"); | .
- qq|\$yo = \$y -> copy(); | .
- qq|\$got = \$x -> blog(\$y);|;
-
- my $desc = "logarithm of $in0 to base $in1";
-
- print("#\n",
- "# Now about to execute the following test.\n",
- "#\n",
- "# $test\n",
- "#\n");
-
- if ($in0 ne 'NaN' && $in1 ne 'NaN') {
- print("# Enter log($in1, $in0) into Wolfram Alpha",
- " (http://www.wolframalpha.com/), and it says that the result",
- " is ", length($type) ? $type : "real",
- length($expr) ? ": $expr" : "",
- ".", "\n",
- "#\n");
- }
-
- eval $test;
- die $@ if $@; # this should never happen
-
- subtest $desc, sub {
- plan tests => 5,
-
- # Check output.
-
- is(ref($got), $class, "output arg is a $class");
- is($got, $out0, 'output arg has the right value');
- is(refaddr($got), refaddr($x), 'output arg is the invocand');
-
- # The second argument (if the invocand is the first) shall *not* be
- # modified.
-
- is(ref($y), $class, "second input arg is still a $class");
- is_deeply($y, $yo, 'second output arg is unmodified');
-
- };
-
-}
-
-__END__
-
-# base = -inf
-
--inf:-inf:NaN:undefined:
--4:-inf:0::
--2:-inf:0::
--1:-inf:0::
--1/2:-inf:0::
-0:-inf:NaN:undefined:
-1/2:-inf:0::
-1:-inf:0::
-2:-inf:0::
-4:-inf:0::
-inf:-inf:NaN:undefined:
-NaN:-inf:NaN:undefined:
-
-# base = -4
-
--4:-4:1::
--2:-4:NaN:non-real and finite:(log(2)+i pi)/(log(4)+i pi)
-0:-4:NaN:non-real (directed) infinity:(-sqrt(pi^2+log^2(4))/(log(4)+i pi))infinity
-1/2:-4:NaN:non-real and finite:-(log(2))/(log(4)+i pi)
-1:-4:0::
-2:-4:NaN:non-real and finite:(log(2))/(log(4)+i pi)
-4:-4:NaN:non-real and finite:(log(4))/(log(4)+i pi)
-NaN:-4:NaN:undefined:
-
-# base = -2
-
--inf:-2:NaN:non-real (directed) infinity:sqrt(pi^2+log^2(2))/(log(2)+i pi)infinity
--4:-2:NaN:non-real and finite:(log(4)+i pi)/(log(2)+i pi)
--2:-2:1::
--1:-2:NaN:non-real and finite:(i pi)/(log(2)+i pi)
--1/2:-2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)+i pi)
-0:-2:NaN:complex infinity:
-1/2:-2:NaN:non-real and finite:-(log(2))/(log(2)+i pi)
-1:-2:0::
-2:-2:NaN:non-real and finite:(log(2))/(log(2)+i pi)
-4:-2:NaN:non-real and finite:(log(4))/(log(2)+i pi)
-inf:-2:NaN:non-real (directed) infinity:
-NaN:-2:NaN:undefined:
-
-# base = -1
-
--inf:-1:NaN:non-real (directed) infinity:
--4:-1:NaN:non-real and finite:-(i (log(4)+i pi))/pi
--2:-1:NaN:non-real and finite:-(i (log(2)+i pi))/pi
--1:-1:1::
--1/2:-1:NaN:non-real and finite:-(i (-log(2)+i pi))/pi
-0:-1:NaN:complex infinity:
-1:-1:0::
-1/2:-1:NaN:non-real and finite:(i log(2))/pi
-2:-1:NaN:non-real and finite:-(i log(2))/pi
-4:-1:NaN:non-real and finite:-(i log(4))/pi
-inf:-1:NaN:non-real (directed) infinity:
-NaN:-1:NaN:undefined:
-
-# base = -1/2
-
--inf:-1/2:NaN:non-real (directed) infinity:
--4:-1/2:NaN:non-real and finite:(log(4)+i pi)/(-log(2)+i pi)
--2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi)
--1:-1/2:NaN:non-real and finite:(i pi)/(-log(2)+i pi)
--1/2:-1/2:1::
-0:-1/2:NaN:complex infinity:
-1:-1/2:0::
-1/2:-1/2:NaN:non-real and finite:-(log(2))/(-log(2)+i pi)
-2:-1/2:NaN:non-real and finite:(log(2))/(-log(2)+i pi)
-4:-1/2:NaN:non-real and finite:(log(4))/(-log(2)+i pi)
-inf:-1/2:NaN:non-real (directed) infinity:
-NaN:-1/2:NaN:undefined:
-
-# base = 0
-
--inf:0:NaN:undefined:
--4:0:0::
--2:0:0::
--1:0:0::
--1/2:0:0::
-0:0:NaN:undefined:
-1/2:0:0::
-1:0:0::
-2:0:0::
-4:0:0::
-inf:0:NaN:undefined:
-NaN:0:NaN:undefined:
-
-# base = 1/2
-
--inf:1/2:-inf::
--2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi)
--1:1/2:NaN:non-real and finite:-(i pi)/(log(2))
--1/2:1/2:NaN:non-real and finite:-(-log(2)+i pi)/(log(2))
-0:1/2:inf::
-1/2:1/2:1::
-1:1/2:0::
-2:1/2:-1::
-inf:1/2:-inf::
-NaN:1/2:NaN:undefined:
-
-# base = 1
-
--inf:1:NaN:complex infinity:
--4:1:NaN:complex infinity:
--2:1:NaN:complex infinity:
--1:1:NaN:complex infinity:
--1/2:1:NaN:complex infinity:
-0:1:NaN:complex infinity:
-1/2:1:NaN:complex infinity:
-1:1:NaN:undefined:
-2:1:NaN:complex infinity:
-4:1:NaN:complex infinity:
-inf:1:NaN:complex infinity:
-NaN:1:NaN:undefined:
-
-# base = 2
-
--inf:2:inf::
--4:2:NaN:non-real and finite:(log(4)+i pi)/(log(2))
--2:2:NaN:non-real and finite:(log(2)+i pi)/(log(2))
--1:2:NaN:non-real and finite:(i pi)/(log(2))
--1/2:2:NaN:non-real and finite:(-log(2)+i pi)/(log(2))
-0:2:-inf::
-1/2:2:-1::
-1:2:0::
-2:2:1::
-4:2:2::
-4:4:1::
-inf:2:inf::
-NaN:2:NaN:undefined:
-
-# base = 4
-
--inf:4:inf::
--4:4:NaN:non-real and finite:(log(4)+i pi)/(log(4))
--2:4:NaN:non-real and finite:(log(2)+i pi)/(log(4))
--1/2:4:NaN:non-real and finite:(-log(2)+i pi)/(log(4))
-0:4:-inf::
-1:4:0::
-1/2:4:-1/2::
-2:4:1/2::
-4:4:1::
-inf:4:inf::
-NaN:4:NaN:undefined:
-
-# base = inf
-
--inf:inf:NaN:undefined:
--4:inf:0::
--2:inf:0::
--1:inf:0::
--1/2:inf:0::
-0:inf:NaN:undefined:
-1:inf:0::
-1/2:inf:0::
-2:inf:0::
-4:inf:0::
-inf:inf:NaN:undefined:
-NaN:inf:NaN:undefined:
-
-# base is NaN
-
--inf:NaN:NaN:undefined:
--4:NaN:NaN:undefined:
--2:NaN:NaN:undefined:
--1:NaN:NaN:undefined:
--1/2:NaN:NaN:undefined:
-0:NaN:NaN:undefined:
-1:NaN:NaN:undefined:
-1/2:NaN:NaN:undefined:
-2:NaN:NaN:undefined:
-4:NaN:NaN:undefined:
-inf:NaN:NaN:undefined:
-NaN:NaN:NaN:undefined:
diff --git a/cpan/Math-BigInt/t/calling.t b/cpan/Math-BigInt/t/calling.t
index 9036b5e03a..81f5b66e68 100644
--- a/cpan/Math-BigInt/t/calling.t
+++ b/cpan/Math-BigInt/t/calling.t
@@ -1,95 +1,107 @@
-#!/usr/bin/perl -w
+#!perl
# test calling conventions, and :constant overloading
use strict;
-use Test::More tests => 160;
+use warnings;
+use lib 't';
-BEGIN { unshift @INC, 't'; }
+my $VERSION = '1.999714'; # adjust manually to match latest release
+$VERSION = eval $VERSION;
+
+use Test::More tests => 161;
+
+##############################################################################
package Math::BigInt::Test;
use Math::BigInt;
-use vars qw/@ISA/;
-@ISA = qw/Math::BigInt/; # child of MBI
+our @ISA = qw/Math::BigInt/; # subclass of MBI
use overload;
+##############################################################################
+
package Math::BigFloat::Test;
use Math::BigFloat;
-use vars qw/@ISA/;
-@ISA = qw/Math::BigFloat/; # child of MBI
+our @ISA = qw/Math::BigFloat/; # subclass of MBI
use overload;
+##############################################################################
+
package main;
use Math::BigInt try => 'Calc';
use Math::BigFloat;
-my ($x,$y,$z,$u);
-my $version = '1.76'; # adjust manually to match latest release
+my ($x, $y, $z, $u);
###############################################################################
# check whether op's accept normal strings, even when inherited by subclasses
# do one positive and one negative test to avoid false positives by "accident"
-my ($func,@args,$ans,$rc,$class,$try);
-while (<DATA>)
- {
- $_ =~ s/[\n\r]//g; # remove newlines
- next if /^#/; # skip comments
- if (s/^&//)
- {
- $func = $_;
+my ($method, $expected);
+while (<DATA>) {
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
+
+ if (s/^&//) {
+ $method = $_;
+ next;
}
- else
+
+ my @args = split /:/, $_, 99;
+ $expected = pop @args;
+ foreach my $class (qw/
+ Math::BigInt Math::BigFloat
+ Math::BigInt::Test Math::BigFloat::Test
+ /)
{
- @args = split(/:/,$_,99);
- $ans = pop @args;
- foreach $class (qw/
- Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
- {
- $try = "'$args[0]'"; # quote it
- $try = $args[0] if $args[0] =~ /'/; # already quoted
- $try = '' if $args[0] eq ''; # undef, no argument
- $try = "$class\->$func($try);";
- $rc = eval $try;
- print "# Tried: '$try'\n" if !is ($rc, $ans);
- }
- }
-
- }
-
-$class = 'Math::BigInt';
-
-# XXX TODO this test does not work/fail.
-# test whether use Math::BigInt qw/version/ works
-#$try = "use $class ($version.'1');";
-#$try .= ' $x = $class->new(123); $x = "$x";';
-#eval $try;
-#is ( $x, undef ); # should result in error!
+ my $arg = $args[0] =~ /"/ || $args[0] eq "" ? $args[0]
+ : qq|"$args[0]"|;
+ my $try = "$class\->$method($arg);";
+ my $got = eval $try;
+ is($got, $expected, $try);
+ }
+}
+
+my $class = 'Math::BigInt';
+
+my $try;
+
+# test whether use Math::BigInt qw/VERSION/ works
+$try = "use $class (" . ($VERSION . '1') .");";
+$try .= ' $x = $class->new(123); $x = "$x";';
+eval $try;
+like($@, qr/ ^ Math::BigInt \s+ ( version \s+ )? \S+ \s+ required--this \s+
+ is \s+ only \s+ version \s+ \S+ /x,
+ $try);
# test whether fallback to calc works
-$try = "use $class ($version,'try','foo, bar , ');";
-$try .= "$class\->config()->{lib};";
-$ans = eval $try;
-like ( $ans, qr/^Math::BigInt::(Fast)?Calc\z/);
+$try = qq|use $class ($VERSION, "try", "foo, bar, ");|
+ . qq| $class\->config()->{lib};|;
+$expected = eval $try;
+like($expected, qr/^Math::BigInt::(Fast)?Calc\z/, $try);
-# test whether constant works or not, also test for qw($version)
+# test whether constant works or not, also test for qw($VERSION)
# bgcd() is present in subclass, too
-$try = "use Math::BigInt ($version,'bgcd',':constant');";
-$try .= ' $x = 2**150; bgcd($x); $x = "$x";';
-$ans = eval $try;
-is ( $ans, "1427247692705959881058285969449495136382746624");
+$try = qq|use $class ($VERSION, "bgcd", ":constant");|
+ . q| $x = 2**150; bgcd($x); $x = "$x";|;
+$expected = eval $try;
+is($expected, "1427247692705959881058285969449495136382746624", $try);
# test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc)
-$try = "use $class ($version,'lib','Scalar');";
-$try .= ' $x = 2**10; $x = "$x";';
-$ans = eval $try; is ( $ans, "1024");
-$try = "use $class ($version,'lib','$class\::Scalar');";
-$try .= ' $x = 2**10; $x = "$x";';
-$ans = eval $try; is ( $ans, "1024");
+$try = qq|use $class ($VERSION, "lib", "Scalar");|
+ . q| $x = 2**10; $x = "$x";|;
+$expected = eval $try;
+is($expected, "1024", $try);
+
+$try = qq|use $class ($VERSION, "lib", "$class\::Scalar");|
+ . q| $x = 2**10; $x = "$x";|;
+$expected = eval $try;
+is($expected, "1024", $try);
# all done
@@ -117,8 +129,8 @@ inf:1
10:10
-10:-10
abc:NaN
-'+inf':inf
-'-inf':-inf
+"+inf":inf
+"-inf":-inf
&bsstr
1:1e+0
0:0e+0
@@ -127,7 +139,7 @@ abc:NaN
-5:-5e+0
-100:-1e+2
abc:NaN
-'+inf':inf
+"+inf":inf
&babs
-1:1
1:1
@@ -141,9 +153,9 @@ abc:NaN
abc:NaN
&bone
:1
-'+':1
-'-':-1
+"+":1
+"-":-1
&binf
:inf
-'+':inf
-'-':-inf
+"+":inf
+"-":-inf
diff --git a/cpan/Math-BigInt/t/config.t b/cpan/Math-BigInt/t/config.t
index 2d079b99ec..685d5d0de2 100644
--- a/cpan/Math-BigInt/t/config.t
+++ b/cpan/Math-BigInt/t/config.t
@@ -1,6 +1,8 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
+
use Test::More tests => 55;
# test whether Math::BigInt->config() and Math::BigFloat->config() works
@@ -8,121 +10,123 @@ use Test::More tests => 55;
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
-my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
+my $mbi = 'Math::BigInt';
+my $mbf = 'Math::BigFloat';
##############################################################################
-# BigInt
+# Math::BigInt
-ok ($mbi->can('config'));
+{
+ can_ok($mbi, 'config');
-my $cfg = $mbi->config();
+ my $cfg = $mbi->config();
-ok (ref($cfg),'HASH');
+ is(ref($cfg), 'HASH', 'ref() of output from $mbi->config()');
-is ($cfg->{lib},'Math::BigInt::Calc', 'lib');
-is ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version');
-is ($cfg->{class},$mbi,'class');
-is ($cfg->{upgrade}||'','', 'upgrade');
-is ($cfg->{div_scale},40, 'div_Scale');
+ is($cfg->{lib}, 'Math::BigInt::Calc', 'lib');
+ is($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version');
+ is($cfg->{class}, $mbi, 'class');
+ is($cfg->{upgrade} || '', '', 'upgrade');
+ is($cfg->{div_scale}, 40, 'div_Scale');
-is ($cfg->{precision}||0,0, 'precision'); # should test for undef
-is ($cfg->{accuracy}||0,0,'accuracy');
-is ($cfg->{round_mode},'even','round_mode');
+ is($cfg->{precision} || 0, 0, 'precision'); # should test for undef
+ is($cfg->{accuracy} || 0, 0, 'accuracy');
+ is($cfg->{round_mode}, 'even', 'round_mode');
-is ($cfg->{trap_nan},0, 'trap_nan');
-is ($cfg->{trap_inf},0, 'trap_inf');
+ is($cfg->{trap_nan}, 0, 'trap_nan');
+ is($cfg->{trap_inf}, 0, 'trap_inf');
-is ($mbi->config('lib'), 'Math::BigInt::Calc', 'config("lib")');
+ is($mbi->config('lib'), 'Math::BigInt::Calc', 'config("lib")');
-# can set via hash ref?
-$cfg = $mbi->config( { trap_nan => 1 } );
-is ($cfg->{trap_nan},1, 'can set via hash ref');
+ # can set via hash ref?
+ $cfg = $mbi->config({ trap_nan => 1 });
+ is($cfg->{trap_nan}, 1, 'can set "trap_nan" via hash ref');
-# reset for later
-$mbi->config( trap_nan => 0 );
+ # reset for later
+ $mbi->config(trap_nan => 0);
+}
##############################################################################
-# BigFloat
+# Math::BigFloat
-ok ($mbf->can('config'));
+{
+ can_ok($mbf, 'config');
-$cfg = $mbf->config();
+ my $cfg = $mbf->config();
-ok (ref($cfg),'HASH');
+ is(ref($cfg), 'HASH', 'ref() of output from $mbf->config()');
-is ($cfg->{lib},'Math::BigInt::Calc', 'lib');
-is ($cfg->{with},'Math::BigInt::Calc', 'with');
-is ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version');
-is ($cfg->{class},$mbf,'class');
-is ($cfg->{upgrade}||'','', 'upgrade');
-is ($cfg->{div_scale},40, 'div_Scale');
+ is($cfg->{lib}, 'Math::BigInt::Calc', 'lib');
+ is($cfg->{with}, 'Math::BigInt::Calc', 'with');
+ is($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version');
+ is($cfg->{class}, $mbf, 'class');
+ is($cfg->{upgrade} || '', '', 'upgrade');
+ is($cfg->{div_scale}, 40, 'div_Scale');
-is ($cfg->{precision}||0,0, 'precision'); # should test for undef
-is ($cfg->{accuracy}||0,0,'accuracy');
-is ($cfg->{round_mode},'even','round_mode');
+ is($cfg->{precision} || 0, 0, 'precision'); # should test for undef
+ is($cfg->{accuracy} || 0, 0, 'accuracy');
+ is($cfg->{round_mode}, 'even', 'round_mode');
-is ($cfg->{trap_nan},0, 'trap_nan');
-is ($cfg->{trap_inf},0, 'trap_inf');
+ is($cfg->{trap_nan}, 0, 'trap_nan');
+ is($cfg->{trap_inf}, 0, 'trap_inf');
-is ($mbf->config('lib'), 'Math::BigInt::Calc', 'config("lib")');
+ is($mbf->config('lib'), 'Math::BigInt::Calc', 'config("lib")');
-# can set via hash ref?
-$cfg = $mbf->config( { trap_nan => 1 } );
-is ($cfg->{trap_nan},1, 'can set via hash ref');
+ # can set via hash ref?
+ $cfg = $mbf->config({ trap_nan => 1 });
+ is($cfg->{trap_nan}, 1, 'can set "trap_nan" via hash ref');
-# reset for later
-$mbf->config( trap_nan => 0 );
+ # reset for later
+ $mbf->config(trap_nan => 0);
+}
##############################################################################
# test setting values
my $test = {
- trap_nan => 1,
- trap_inf => 1,
- accuracy => 2,
- precision => 3,
- round_mode => 'zero',
- div_scale => '100',
- upgrade => 'Math::BigInt::SomeClass',
- downgrade => 'Math::BigInt::SomeClass',
- };
+ trap_nan => 1,
+ trap_inf => 1,
+ accuracy => 2,
+ precision => 3,
+ round_mode => 'zero',
+ div_scale => '100',
+ upgrade => 'Math::BigInt::SomeClass',
+ downgrade => 'Math::BigInt::SomeClass',
+};
my $c;
-foreach my $key (keys %$test)
- {
- # see if setting in MBI works
- eval ( "$mbi\->config( $key => '$test->{$key}' );" );
- $c = $mbi->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
- $c = $mbf->config();
- # see if setting it in MBI leaves MBF alone
- if (($c->{$key}||0) ne $test->{$key})
- {
- is (1,1);
- }
- else
- {
- is ("$key eq $c->{$key}","$key ne $test->{$key}", "$key");
- }
-
- # see if setting in MBF works
- eval ( "$mbf\->config( $key => '$test->{$key}' );" );
- $c = $mbf->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
- }
+foreach my $key (keys %$test) {
-##############################################################################
-# test setting illegal keys (should croak)
-
-$@ = ""; my $never_reached = 0;
-eval ("$mbi\->config( 'some_garbage' => 1 ); $never_reached = 1;");
-is ($never_reached,0);
+ # see if setting in MBI works
+ eval { $mbi->config($key => $test->{$key}); };
+ $c = $mbi->config();
+ is("$key = $c->{$key}", "$key = $test->{$key}", "$key = $test->{$key}");
+ $c = $mbf->config();
-$@ = ""; $never_reached = 0;
-eval ("$mbf\->config( 'some_garbage' => 1 ); $never_reached = 1;");
-is ($never_reached,0);
+ # see if setting it in MBI leaves MBF alone
+ ok(($c->{$key} || 0) ne $test->{$key},
+ "$key ne \$c->{$key}");
-# this does not work. Why?
-#ok ($@ eq "Illegal keys 'some_garbage' passed to Math::BigInt->config() at ./config.t line 104", 1);
+ # see if setting in MBF works
+ eval { $mbf->config($key => $test->{$key}); };
+ $c = $mbf->config();
+ is("$key = $c->{$key}", "$key = $test->{$key}", "$key = $test->{$key}");
+}
-# all tests done
+##############################################################################
+# test setting illegal keys (should croak)
+eval { $mbi->config('some_garbage' => 1); };
+like($@,
+ qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+
+ Math::BigInt->config\(\) \s+ at
+ /x,
+ 'Passing invalid key to Math::BigInt->config() causes an error.');
+
+eval { $mbf->config('some_garbage' => 1); };
+like($@,
+ qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+
+ Math::BigFloat->config\(\) \s+ at
+ /x,
+ 'Passing invalid key to Math::BigFloat->config() causes an error.');
diff --git a/cpan/Math-BigInt/t/const_mbf.t b/cpan/Math-BigInt/t/const_mbf.t
index 84f7a8cf99..37524a357b 100644
--- a/cpan/Math-BigInt/t/const_mbf.t
+++ b/cpan/Math-BigInt/t/const_mbf.t
@@ -1,14 +1,16 @@
-#!/usr/bin/perl -w
+#!perl
-# test BigFloat constants alone (w/o BigInt loading)
+# test Math::BigFloat constants alone (w/o Math::BigInt loading)
use strict;
+use warnings;
+
use Test::More tests => 2;
use Math::BigFloat ':constant';
-is (1.0 / 3.0, '0.3333333333333333333333333333333333333333');
-
-# BigInt was not loaded with ':constant', so only floats are handled
-is (ref(2 ** 2),'');
+is(1.0 / 3.0, '0.3333333333333333333333333333333333333333',
+ "1.0 / 3.0 = 0.3333333333333333333333333333333333333333");
+# Math::BigInt was not loaded with ':constant', so only floats are handled
+is(ref(2 ** 2), '', "2 ** 2 is a scalar");
diff --git a/cpan/Math-BigInt/t/constant.t b/cpan/Math-BigInt/t/constant.t
index ad8afeed2d..1f760d6280 100644
--- a/cpan/Math-BigInt/t/constant.t
+++ b/cpan/Math-BigInt/t/constant.t
@@ -1,35 +1,46 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
+
use Test::More tests => 7;
use Math::BigInt ':constant';
-is (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968');
+is(2 ** 255,
+ '578960446186580977117854925043439539266'
+ . '34992332820282019728792003956564819968',
+ '2 ** 255');
{
- no warnings 'portable'; # protect against "non-portable" warnings
-# hexadecimal constants
-is (0x123456789012345678901234567890,
- Math::BigInt->new('0x123456789012345678901234567890'));
-# binary constants
-is (0b01010100011001010110110001110011010010010110000101101101,
- Math::BigInt->new(
- '0b01010100011001010110110001110011010010010110000101101101'));
+ no warnings 'portable'; # protect against "non-portable" warnings
+
+ # hexadecimal constants
+ is(0x123456789012345678901234567890,
+ Math::BigInt->new('0x123456789012345678901234567890'),
+ 'hexadecimal constant 0x123456789012345678901234567890');
+
+ # binary constants
+ is(0b01010100011001010110110001110011010010010110000101101101,
+ Math::BigInt->new('0b0101010001100101011011000111'
+ . '0011010010010110000101101101'),
+ 'binary constant 0b0101010001100101011011000111'
+ . '0011010010010110000101101101');
}
use Math::BigFloat ':constant';
-is (1.0 / 3.0, '0.3333333333333333333333333333333333333333');
+is(1.0 / 3.0, '0.3333333333333333333333333333333333333333',
+ '1.0 / 3.0 = 0.3333333333333333333333333333333333333333');
# stress-test Math::BigFloat->import()
-Math::BigFloat->import( qw/:constant/ );
-is (1,1);
+Math::BigFloat->import(qw/:constant/);
+pass('Math::BigFloat->import(qw/:constant/);');
-Math::BigFloat->import( qw/:constant upgrade Math::BigRat/ );
-is (1,1);
+Math::BigFloat->import(qw/:constant upgrade Math::BigRat/);
+pass('Math::BigFloat->import(qw/:constant upgrade Math::BigRat/);');
-Math::BigFloat->import( qw/upgrade Math::BigRat :constant/ );
-is (1,1);
+Math::BigFloat->import(qw/upgrade Math::BigRat :constant/);
+pass('Math::BigFloat->import(qw/upgrade Math::BigRat :constant/);');
# all tests done
diff --git a/cpan/Math-BigInt/t/downgrade.t b/cpan/Math-BigInt/t/downgrade.t
index f6b011e5a0..7f515ea2be 100644
--- a/cpan/Math-BigInt/t/downgrade.t
+++ b/cpan/Math-BigInt/t/downgrade.t
@@ -1,45 +1,57 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
+
use Test::More tests => 15;
-use Math::BigInt upgrade => 'Math::BigFloat';
-use Math::BigFloat downgrade => 'Math::BigInt', upgrade => 'Math::BigInt';
+use Math::BigInt upgrade => 'Math::BigFloat';
+use Math::BigFloat downgrade => 'Math::BigInt',
+ upgrade => 'Math::BigInt';
+
-use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup
- $ECL $CL);
-$class = "Math::BigInt";
-$CL = "Math::BigInt::Calc";
-$ECL = "Math::BigFloat";
+our ($CLASS, $EXPECTED_CLASS, $CALC);
+$CLASS = "Math::BigInt";
+$EXPECTED_CLASS = "Math::BigFloat";
+$CALC = "Math::BigInt::Calc"; # backend
-# simplistic test for now
-is (Math::BigFloat->downgrade(),'Math::BigInt');
-is (Math::BigFloat->upgrade(),'Math::BigInt');
+# simplistic test for now
+is(Math::BigFloat->downgrade(), 'Math::BigInt', 'Math::BigFloat->downgrade()');
+is(Math::BigFloat->upgrade(), 'Math::BigInt', 'Math::BigFloat->upgrade()');
# these downgrade
-is (ref(Math::BigFloat->new('inf')),'Math::BigInt');
-is (ref(Math::BigFloat->new('-inf')),'Math::BigInt');
-is (ref(Math::BigFloat->new('NaN')),'Math::BigInt');
-is (ref(Math::BigFloat->new('0')),'Math::BigInt');
-is (ref(Math::BigFloat->new('1')),'Math::BigInt');
-is (ref(Math::BigFloat->new('10')),'Math::BigInt');
-is (ref(Math::BigFloat->new('-10')),'Math::BigInt');
-is (ref(Math::BigFloat->new('-10.0E1')),'Math::BigInt');
+is(ref(Math::BigFloat->new("inf")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("inf"))|);
+is(ref(Math::BigFloat->new("-inf")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("-inf"))|);
+is(ref(Math::BigFloat->new("NaN")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("NaN"))|);
+is(ref(Math::BigFloat->new("0")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("0"))|);
+is(ref(Math::BigFloat->new("1")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("1"))|);
+is(ref(Math::BigFloat->new("10")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("10"))|);
+is(ref(Math::BigFloat->new("-10")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("-10"))|);
+is(ref(Math::BigFloat->new("-10.0E1")), "Math::BigInt",
+ qq|ref(Math::BigFloat->new("-10.0E1"))|);
# bug until v1.67:
-is (Math::BigFloat->new('0.2E0'), '0.2');
-is (Math::BigFloat->new('0.2E1'), '2');
+is(Math::BigFloat->new("0.2E0"), "0.2", qq|Math::BigFloat->new("0.2E0")|);
+is(Math::BigFloat->new("0.2E1"), "2", qq|Math::BigFloat->new("0.2E1")|);
# until v1.67 resulted in 200:
-is (Math::BigFloat->new('0.2E2'), '20');
+is(Math::BigFloat->new("0.2E2"), "20", qq|Math::BigFloat->new("0.2E2")|);
# disable, otherwise it screws calculations
Math::BigFloat->upgrade(undef);
-is (Math::BigFloat->upgrade()||'','');
+is(Math::BigFloat->upgrade() || "", "", qq/Math::BigFloat->upgrade() || ""/);
-Math::BigFloat->div_scale(20); # make it a bit faster
-my $x = Math::BigFloat->new(2); # downgrades
+Math::BigFloat->div_scale(20); # make it a bit faster
+my $x = Math::BigFloat->new(2); # downgrades
# the following test upgrade for bsqrt() and also makes new() NOT downgrade
# for the bpow() side
-is (Math::BigFloat->bpow('2','0.5'),$x->bsqrt());
+is(Math::BigFloat->bpow("2", "0.5"), $x->bsqrt(),
+ qq|Math::BigFloat->bpow("2", "0.5")|);
#require 'upgrade.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/from_hex-mbf.t b/cpan/Math-BigInt/t/from_hex-mbf.t
index 1322916c01..a15e4fddb1 100644
--- a/cpan/Math-BigInt/t/from_hex-mbf.t
+++ b/cpan/Math-BigInt/t/from_hex-mbf.t
@@ -11,22 +11,16 @@ BEGIN { $class = 'Math::BigFloat'; }
BEGIN { use_ok($class, '1.999710'); }
while (<DATA>) {
- s/\s+\z//;
- next if /^#/ || ! /\S/;
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
my ($in0, $out0) = split /:/;
my $x;
my $test = qq|\$x = $class -> from_hex("$in0");|;
-
my $desc = $test;
- print("#\n",
- "# Now about to execute the following test.\n",
- "#\n",
- "# $test\n",
- "#\n");
-
eval $test;
die $@ if $@; # this should never happen
diff --git a/cpan/Math-BigInt/t/inf_nan.t b/cpan/Math-BigInt/t/inf_nan.t
index 270689bac6..f297c1d9d9 100644
--- a/cpan/Math-BigInt/t/inf_nan.t
+++ b/cpan/Math-BigInt/t/inf_nan.t
@@ -1,404 +1,400 @@
-#!/usr/bin/perl -w
+#!perl
# test inf/NaN handling all in one place
# Thanx to Jarkko for the excellent explanations and the tables
use strict;
+use warnings;
+use lib 't';
-use Test::More
- tests => 7 * 6 * 5 * 4 * 2 +
- 7 * 6 * 2 * 4 * 1 # bmod
-;
-# see bottom: + 4 * 10; # 4 classes * 10 NaN == NaN tests
-
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 2052;
use Math::BigInt;
use Math::BigFloat;
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
-my @biclasses =
- qw/ Math::BigInt Math::BigInt::Subclass /;
-my @bfclasses =
- qw/ Math::BigFloat Math::BigFloat::Subclass /;
+my @biclasses = qw/ Math::BigInt Math::BigInt::Subclass /;
+my @bfclasses = qw/ Math::BigFloat Math::BigFloat::Subclass /;
-my (@args,$x,$y,$z);
+my (@args, $x, $y, $z);
# +
+
foreach (qw/
- -inf:-inf:-inf
- -1:-inf:-inf
- -0:-inf:-inf
- 0:-inf:-inf
- 1:-inf:-inf
- inf:-inf:NaN
- NaN:-inf:NaN
-
- -inf:-1:-inf
- -1:-1:-2
- -0:-1:-1
- 0:-1:-1
- 1:-1:0
- inf:-1:inf
- NaN:-1:NaN
-
- -inf:0:-inf
- -1:0:-1
- -0:0:0
- 0:0:0
- 1:0:1
- inf:0:inf
- NaN:0:NaN
-
- -inf:1:-inf
- -1:1:0
- -0:1:1
- 0:1:1
- 1:1:2
- inf:1:inf
- NaN:1:NaN
-
- -inf:inf:NaN
- -1:inf:inf
- -0:inf:inf
- 0:inf:inf
- 1:inf:inf
- inf:inf:inf
- NaN:inf:NaN
-
- -inf:NaN:NaN
- -1:NaN:NaN
- -0:NaN:NaN
- 0:NaN:NaN
- 1:NaN:NaN
- inf:NaN:NaN
- NaN:NaN:NaN
+
+ -inf:-inf:-inf
+ -1:-inf:-inf
+ -0:-inf:-inf
+ 0:-inf:-inf
+ 1:-inf:-inf
+ inf:-inf:NaN
+ NaN:-inf:NaN
+
+ -inf:-1:-inf
+ -1:-1:-2
+ -0:-1:-1
+ 0:-1:-1
+ 1:-1:0
+ inf:-1:inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-1
+ -0:0:0
+ 0:0:0
+ 1:0:1
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:0
+ -0:1:1
+ 0:1:1
+ 1:1:2
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:NaN
+ -1:inf:inf
+ -0:inf:inf
+ 0:inf:inf
+ 1:inf:inf
+ inf:inf:inf
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+
/)
- {
- @args = split /:/,$_;
- for my $class (@biclasses, @bfclasses)
- {
- $x = $class->new($args[0]);
- $y = $class->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- my $r = $x->badd($y);
-
- is($x->bstr(),$args[2],"x $class $args[0] + $args[1]");
- is($x->bstr(),$args[2],"r $class $args[0] + $args[1]");
+{
+ @args = split /:/, $_;
+ for my $class (@biclasses, @bfclasses) {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0
+ my $r = $x->badd($y);
+
+ is($x->bstr(), $args[2], "x $class $args[0] + $args[1]");
+ is($x->bstr(), $args[2], "r $class $args[0] + $args[1]");
}
- }
+}
# -
+
foreach (qw/
- -inf:-inf:NaN
- -1:-inf:inf
- -0:-inf:inf
- 0:-inf:inf
- 1:-inf:inf
- inf:-inf:inf
- NaN:-inf:NaN
-
- -inf:-1:-inf
- -1:-1:0
- -0:-1:1
- 0:-1:1
- 1:-1:2
- inf:-1:inf
- NaN:-1:NaN
-
- -inf:0:-inf
- -1:0:-1
- -0:0:-0
- 0:0:0
- 1:0:1
- inf:0:inf
- NaN:0:NaN
-
- -inf:1:-inf
- -1:1:-2
- -0:1:-1
- 0:1:-1
- 1:1:0
- inf:1:inf
- NaN:1:NaN
-
- -inf:inf:-inf
- -1:inf:-inf
- -0:inf:-inf
- 0:inf:-inf
- 1:inf:-inf
- inf:inf:NaN
- NaN:inf:NaN
-
- -inf:NaN:NaN
- -1:NaN:NaN
- -0:NaN:NaN
- 0:NaN:NaN
- 1:NaN:NaN
- inf:NaN:NaN
- NaN:NaN:NaN
+
+ -inf:-inf:NaN
+ -1:-inf:inf
+ -0:-inf:inf
+ 0:-inf:inf
+ 1:-inf:inf
+ inf:-inf:inf
+ NaN:-inf:NaN
+
+ -inf:-1:-inf
+ -1:-1:0
+ -0:-1:1
+ 0:-1:1
+ 1:-1:2
+ inf:-1:inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-1
+ -0:0:-0
+ 0:0:0
+ 1:0:1
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-2
+ -0:1:-1
+ 0:1:-1
+ 1:1:0
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:-inf
+ -1:inf:-inf
+ -0:inf:-inf
+ 0:inf:-inf
+ 1:inf:-inf
+ inf:inf:NaN
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+
/)
- {
- @args = split /:/,$_;
- for my $class (@biclasses, @bfclasses)
- {
- $x = $class->new($args[0]);
- $y = $class->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- my $r = $x->bsub($y);
-
- is($x->bstr(),$args[2],"x $class $args[0] - $args[1]");
- is($r->bstr(),$args[2],"r $class $args[0] - $args[1]");
+{
+ @args = split /:/, $_;
+ for my $class (@biclasses, @bfclasses) {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0
+ my $r = $x->bsub($y);
+
+ is($x->bstr(), $args[2], "x $class $args[0] - $args[1]");
+ is($r->bstr(), $args[2], "r $class $args[0] - $args[1]");
}
- }
+}
# *
-foreach (qw/
- -inf:-inf:inf
- -1:-inf:inf
- -0:-inf:NaN
- 0:-inf:NaN
- 1:-inf:-inf
- inf:-inf:-inf
- NaN:-inf:NaN
-
- -inf:-1:inf
- -1:-1:1
- -0:-1:0
- 0:-1:-0
- 1:-1:-1
- inf:-1:-inf
- NaN:-1:NaN
-
- -inf:0:NaN
- -1:0:-0
- -0:0:-0
- 0:0:0
- 1:0:0
- inf:0:NaN
- NaN:0:NaN
-
- -inf:1:-inf
- -1:1:-1
- -0:1:-0
- 0:1:0
- 1:1:1
- inf:1:inf
- NaN:1:NaN
-
- -inf:inf:-inf
- -1:inf:-inf
- -0:inf:NaN
- 0:inf:NaN
- 1:inf:inf
- inf:inf:inf
- NaN:inf:NaN
-
- -inf:NaN:NaN
- -1:NaN:NaN
- -0:NaN:NaN
- 0:NaN:NaN
- 1:NaN:NaN
- inf:NaN:NaN
- NaN:NaN:NaN
- /)
- {
- @args = split /:/,$_;
- for my $class (@biclasses, @bfclasses)
- {
- $x = $class->new($args[0]);
- $y = $class->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
- $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
- my $r = $x->bmul($y);
-
- is($x->bstr(),$args[2],"x $class $args[0] * $args[1]");
- is($r->bstr(),$args[2],"r $class $args[0] * $args[1]");
- }
- }
-# /
foreach (qw/
- -inf:-inf:NaN
- -1:-inf:0
- -0:-inf:0
- 0:-inf:-0
- 1:-inf:-1
- inf:-inf:NaN
- NaN:-inf:NaN
-
- -inf:-1:inf
- -1:-1:1
- -0:-1:0
- 0:-1:-0
- 1:-1:-1
- inf:-1:-inf
- NaN:-1:NaN
-
- -inf:0:-inf
- -1:0:-inf
- -0:0:NaN
- 0:0:NaN
- 1:0:inf
- inf:0:inf
- NaN:0:NaN
-
- -inf:1:-inf
- -1:1:-1
- -0:1:-0
- 0:1:0
- 1:1:1
- inf:1:inf
- NaN:1:NaN
-
- -inf:inf:NaN
- -1:inf:-1
- -0:inf:-0
- 0:inf:0
- 1:inf:0
- inf:inf:NaN
- NaN:inf:NaN
-
- -inf:NaN:NaN
- -1:NaN:NaN
- -0:NaN:NaN
- 0:NaN:NaN
- 1:NaN:NaN
- inf:NaN:NaN
- NaN:NaN:NaN
- /)
- {
- @args = split /:/,$_;
- for my $class (@biclasses, @bfclasses)
- {
- $x = $class->new($args[0]);
- $y = $class->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
-
- my $t = $x->copy();
- my $tmod = $t->copy();
-
- # bdiv in scalar context
- unless ($class =~ /^Math::BigFloat/) {
- my $r = $x->bdiv($y);
- is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
- is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");
- }
- # bmod and bdiv in list context
- my ($d,$rem) = $t->bdiv($y);
+ -inf:-inf:inf
+ -1:-inf:inf
+ -0:-inf:NaN
+ 0:-inf:NaN
+ 1:-inf:-inf
+ inf:-inf:-inf
+ NaN:-inf:NaN
+
+ -inf:-1:inf
+ -1:-1:1
+ -0:-1:0
+ 0:-1:-0
+ 1:-1:-1
+ inf:-1:-inf
+ NaN:-1:NaN
+
+ -inf:0:NaN
+ -1:0:-0
+ -0:0:-0
+ 0:0:0
+ 1:0:0
+ inf:0:NaN
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-1
+ -0:1:-0
+ 0:1:0
+ 1:1:1
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:-inf
+ -1:inf:-inf
+ -0:inf:NaN
+ 0:inf:NaN
+ 1:inf:inf
+ inf:inf:inf
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+
+ /)
+{
+ @args = split /:/, $_;
+ for my $class (@biclasses, @bfclasses) {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0
+ my $r = $x->bmul($y);
+
+ is($x->bstr(), $args[2], "x $class $args[0] * $args[1]");
+ is($r->bstr(), $args[2], "r $class $args[0] * $args[1]");
+ }
+}
- # bdiv in list context
- is($t->bstr(),$args[2],"t $class $args[0] / $args[1]");
- is($d->bstr(),$args[2],"d $class $args[0] / $args[1]");
-
- # bmod
- my $m = $tmod->bmod($y);
+# /
- # bmod() agrees with bdiv?
- is($m->bstr(),$rem->bstr(),"m $class $args[0] % $args[1]");
- # bmod() return agrees with set value?
- is($tmod->bstr(),$m->bstr(),"o $class $args[0] % $args[1]");
+foreach (qw/
+ -inf:-inf:NaN
+ -1:-inf:0
+ -0:-inf:0
+ 0:-inf:-0
+ 1:-inf:-1
+ inf:-inf:NaN
+ NaN:-inf:NaN
+
+ -inf:-1:inf
+ -1:-1:1
+ -0:-1:0
+ 0:-1:-0
+ 1:-1:-1
+ inf:-1:-inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-inf
+ -0:0:NaN
+ 0:0:NaN
+ 1:0:inf
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-1
+ -0:1:-0
+ 0:1:0
+ 1:1:1
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:NaN
+ -1:inf:-1
+ -0:inf:-0
+ 0:inf:0
+ 1:inf:0
+ inf:inf:NaN
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+
+ /)
+{
+ @args = split /:/, $_;
+ for my $class (@biclasses, @bfclasses) {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0
+
+ my $t = $x->copy();
+ my $tmod = $t->copy();
+
+ # bdiv in scalar context
+ unless ($class =~ /^Math::BigFloat/) {
+ my $r = $x->bdiv($y);
+ is($x->bstr(), $args[2], "x $class $args[0] / $args[1]");
+ is($r->bstr(), $args[2], "r $class $args[0] / $args[1]");
+ }
+
+ # bmod and bdiv in list context
+ my ($d, $rem) = $t->bdiv($y);
+
+ # bdiv in list context
+ is($t->bstr(), $args[2], "t $class $args[0] / $args[1]");
+ is($d->bstr(), $args[2], "d $class $args[0] / $args[1]");
+
+ # bmod
+ my $m = $tmod->bmod($y);
+
+ # bmod() agrees with bdiv?
+ is($m->bstr(), $rem->bstr(), "m $class $args[0] % $args[1]");
+ # bmod() return agrees with set value?
+ is($tmod->bstr(), $m->bstr(), "o $class $args[0] % $args[1]");
}
- }
+}
# /
+
foreach (qw/
- -inf:-inf:NaN
- -1:-inf:0
- -0:-inf:0
- 0:-inf:-0
- 1:-inf:-0
- inf:-inf:NaN
- NaN:-inf:NaN
-
- -inf:-1:inf
- -1:-1:1
- -0:-1:0
- 0:-1:-0
- 1:-1:-1
- inf:-1:-inf
- NaN:-1:NaN
-
- -inf:0:-inf
- -1:0:-inf
- -0:0:NaN
- 0:0:NaN
- 1:0:inf
- inf:0:inf
- NaN:0:NaN
-
- -inf:1:-inf
- -1:1:-1
- -0:1:-0
- 0:1:0
- 1:1:1
- inf:1:inf
- NaN:1:NaN
-
- -inf:inf:NaN
- -1:inf:-0
- -0:inf:-0
- 0:inf:0
- 1:inf:0
- inf:inf:NaN
- NaN:inf:NaN
-
- -inf:NaN:NaN
- -1:NaN:NaN
- -0:NaN:NaN
- 0:NaN:NaN
- 1:NaN:NaN
- inf:NaN:NaN
- NaN:NaN:NaN
- /)
- {
- @args = split /:/,$_;
- for my $class (@bfclasses)
- {
- $x = $class->new($args[0]);
- $y = $class->new($args[1]);
- $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
-
- my $t = $x->copy();
- my $tmod = $t->copy();
-
- # bdiv in scalar context
- my $r = $x->bdiv($y);
- is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
- is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");
+ -inf:-inf:NaN
+ -1:-inf:0
+ -0:-inf:0
+ 0:-inf:-0
+ 1:-inf:-0
+ inf:-inf:NaN
+ NaN:-inf:NaN
+
+ -inf:-1:inf
+ -1:-1:1
+ -0:-1:0
+ 0:-1:-0
+ 1:-1:-1
+ inf:-1:-inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-inf
+ -0:0:NaN
+ 0:0:NaN
+ 1:0:inf
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-1
+ -0:1:-0
+ 0:1:0
+ 1:1:1
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:NaN
+ -1:inf:-0
+ -0:inf:-0
+ 0:inf:0
+ 1:inf:0
+ inf:inf:NaN
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+
+ /)
+{
+ @args = split /:/, $_;
+ for my $class (@bfclasses) {
+ $x = $class->new($args[0]);
+ $y = $class->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0
+
+ my $t = $x->copy();
+ my $tmod = $t->copy();
+
+ # bdiv in scalar context
+ my $r = $x->bdiv($y);
+ is($x->bstr(), $args[2], "x $class $args[0] / $args[1]");
+ is($r->bstr(), $args[2], "r $class $args[0] / $args[1]");
}
- }
+}
#############################################################################
# overloaded comparisons
-# these are disabled for now, since Perl itself can't seem to make up it's
-# mind what NaN actually is, see [perl #33106].
-
-#
-#foreach my $c (@biclasses, @bfclasses)
-# {
-# my $x = $c->bnan();
-# my $y = $c->bnan(); # test with two different objects, too
-# my $a = $c->bzero();
-#
-# is ($x == $y, undef, 'NaN == NaN: undef');
-# is ($x != $y, 1, 'NaN != NaN: 1');
-#
-# is ($x == $x, undef, 'NaN == NaN: undef');
-# is ($x != $x, 1, 'NaN != NaN: 1');
-#
-# is ($a != $x, 1, '0 != NaN: 1');
-# is ($a == $x, undef, '0 == NaN: undef');
-#
-# is ($a < $x, undef, '0 < NaN: undef');
-# is ($a <= $x, undef, '0 <= NaN: undef');
-# is ($a >= $x, undef, '0 >= NaN: undef');
-# is ($a > $x, undef, '0 > NaN: undef');
-# }
+foreach my $c (@biclasses, @bfclasses) {
+ my $x = $c->bnan();
+ my $y = $c->bnan(); # test with two different objects, too
+ my $z = $c->bzero();
+
+ is($x == $y, '', 'NaN == NaN: ""');
+ is($x != $y, 1, 'NaN != NaN: 1');
+
+ is($x == $x, '', 'NaN == NaN: ""');
+ is($x != $x, 1, 'NaN != NaN: 1');
+
+ is($z != $x, 1, '0 != NaN: 1');
+ is($z == $x, '', '0 == NaN: ""');
+
+ is($z < $x, '', '0 < NaN: ""');
+ is($z <= $x, '', '0 <= NaN: ""');
+ is($z >= $x, '', '0 >= NaN: ""');
+ #is($z > $x, '', '0 > NaN: ""'); # Bug! Todo: fix it!
+}
# All done.
diff --git a/cpan/Math-BigInt/t/isa.t b/cpan/Math-BigInt/t/isa.t
index 0bdf66fda2..68914cee64 100644
--- a/cpan/Math-BigInt/t/isa.t
+++ b/cpan/Math-BigInt/t/isa.t
@@ -1,34 +1,51 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 7;
+use warnings;
+use lib 't';
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 11;
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
use Math::BigInt;
use Math::BigFloat;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigInt::Subclass";
-$CL = "Math::BigInt::Calc";
+my $class = "Math::BigInt::Subclass";
+my $CALC = "Math::BigInt::Calc";
-# Check that a subclass is still considered a BigInt
-isa_ok ($class->new(123), 'Math::BigInt');
+# Check that a subclass is still considered a Math::BigInt
+isa_ok($class->new(123), 'Math::BigInt');
# ditto for plain Math::BigInt
-isa_ok (Math::BigInt->new(123), 'Math::BigInt');
+isa_ok(Math::BigInt->new(123), 'Math::BigInt');
# But Math::BigFloats aren't
-isnt (Math::BigFloat->new(123)->isa('Math::BigInt'), 1);
-
-# see what happens if we feed a Math::BigFloat into new()
-$x = Math::BigInt->new(Math::BigFloat->new(123));
-is (ref($x),'Math::BigInt');
-isa_ok ($x, 'Math::BigInt');
-
-# ditto for subclass
-$x = Math::BigInt->new(Math::BigFloat->new(123));
-is (ref($x),'Math::BigInt');
-isa_ok ($x, 'Math::BigInt');
+ok(!Math::BigFloat->new(123)->isa('Math::BigInt'),
+ "A Math::BigFloat isn't a Math::BigInt");
+
+{
+ # see what happens if we feed a Math::BigFloat into new()
+ my $x = Math::BigInt->new(Math::BigFloat->new(123));
+ is(ref($x), 'Math::BigInt', 'ref($x) = "Math::BigInt"');
+ isa_ok($x, 'Math::BigInt');
+}
+
+{
+ # ditto for subclass
+ my $x = Math::BigInt->new(Math::BigFloat::Subclass->new(123));
+ is(ref($x), 'Math::BigInt', 'ref($x) = "Math::BigInt"');
+ isa_ok($x, 'Math::BigInt');
+}
+
+{
+ my $x = Math::BigFloat->new(Math::BigInt->new(123));
+ is(ref($x), 'Math::BigFloat', 'ref($x) = "Math::BigFloat"');
+ isa_ok($x, 'Math::BigFloat');
+}
+
+{
+ my $x = Math::BigFloat->new(Math::BigInt::Subclass->new(123));
+ is(ref($x), 'Math::BigFloat', 'ref($x) = "Math::BigFloat"');
+ isa_ok($x, 'Math::BigFloat');
+}
diff --git a/cpan/Math-BigInt/t/lib_load.t b/cpan/Math-BigInt/t/lib_load.t
index 65a913ac35..04f1c308c0 100644
--- a/cpan/Math-BigInt/t/lib_load.t
+++ b/cpan/Math-BigInt/t/lib_load.t
@@ -1,29 +1,32 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
+
use Test::More tests => 4;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
-# first load BigInt with Calc
+# first load Math::BigInt with Math::BigInt::Calc
use Math::BigInt lib => 'Calc';
-# BigFloat will remember that we loaded Calc
+# Math::BigFloat will remember that we loaded Math::BigInt::Calc
require Math::BigFloat;
-is (Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', 'BigFloat got Calc');
+is(Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc',
+ 'Math::BigFloat got Math::BigInt::Calc');
-# now load BigInt again with a different lib
-Math::BigInt->import( lib => 'BareCalc' );
+# now load Math::BigInt again with a different lib
+Math::BigInt->import(lib => 'BareCalc');
-# and finally test that BigFloat knows about BareCalc
+# and finally test that Math::BigFloat knows about Math::BigInt::BareCalc
-is (Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', 'BigFloat was notified');
+is(Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigFloat was notified');
# See that Math::BigFloat supports "only"
eval "Math::BigFloat->import('only' => 'Calc')";
-is (Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', '"only" worked');
+is(Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', '"only" worked');
# See that Math::BigFloat supports "try"
eval "Math::BigFloat->import('try' => 'BareCalc')";
-is (Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', '"try" worked');
-
+is(Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', '"try" worked');
diff --git a/cpan/Math-BigInt/t/mbf_ali.t b/cpan/Math-BigInt/t/mbf_ali.t
index 845fbe94e1..b44b64c55f 100644
--- a/cpan/Math-BigInt/t/mbf_ali.t
+++ b/cpan/Math-BigInt/t/mbf_ali.t
@@ -1,14 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
# test that the new alias names work
use strict;
+use warnings;
+
use Test::More tests => 6;
use Math::BigFloat;
-use vars qw/$x $CL/;
-
-$CL = 'Math::BigFloat';
+our $CLASS;
+$CLASS = 'Math::BigFloat';
require 't/alias.inc';
diff --git a/cpan/Math-BigInt/t/mbi_ali.t b/cpan/Math-BigInt/t/mbi_ali.t
index d52812bec9..e65aa3c489 100644
--- a/cpan/Math-BigInt/t/mbi_ali.t
+++ b/cpan/Math-BigInt/t/mbi_ali.t
@@ -1,14 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
# test that the new alias names work
use strict;
+use warnings;
+
use Test::More tests => 6;
use Math::BigInt;
-use vars qw/$x $CL/;
-
-$CL = 'Math::BigInt';
+our $CLASS;
+$CLASS = 'Math::BigInt';
require 't/alias.inc';
diff --git a/cpan/Math-BigInt/t/mbi_rand.t b/cpan/Math-BigInt/t/mbi_rand.t
index a6e3b21c8b..1f49021dc9 100644
--- a/cpan/Math-BigInt/t/mbi_rand.t
+++ b/cpan/Math-BigInt/t/mbi_rand.t
@@ -1,86 +1,102 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
+use warnings;
my $count;
BEGIN {
- $count = 128;
+ $count = 128;
}
-use Test::More tests => $count*4;
+use Test::More tests => $count * 4;
use Math::BigInt;
-my $c = 'Math::BigInt';
+my $class = 'Math::BigInt';
my $length = 128;
# If you get a failure here, please re-run the test with the printed seed
# value as input "perl t/mbi_rand.t seed" and send me the output
-my $seed = ($#ARGV == 0) ? $ARGV[0] : int(rand(1165537));
-print "# seed: $seed\n"; srand($seed);
+my $seed = @ARGV == 1 ? $ARGV[0] : int(rand(1165537));
+#diag(" seed: $seed\n");
+srand($seed);
-print "# lib: ", Math::BigInt->config()->{lib},"\n";
-if (Math::BigInt->config()->{lib} =~ /::Calc/)
- {
- print "# base len: ", scalar Math::BigInt::Calc->_base_len(),"\n";
- }
+my $_base_len;
+my @_base_len;
-my ($A,$B,$As,$Bs,$ADB,$AMB,$la,$lb);
+#diag(" lib: ", Math::BigInt->config()->{lib});
+if (Math::BigInt->config()->{lib} =~ /::Calc/) {
+ $_base_len = Math::BigInt::Calc->_base_len();
+ @_base_len = Math::BigInt::Calc->_base_len();
+ #diag("base len: $_base_len (scalar context)");
+ #diag("base len: @_base_len (list contex)");
+}
+
+my ($A, $B, $A_str, $B_str, $AdivB, $AmodB, $A_len, $B_len);
my $two = Math::BigInt->new(2);
-for (my $i = 0; $i < $count; $i++)
- {
- # length of A and B
- $la = int(rand($length)+1); $lb = int(rand($length)+1);
- $As = ''; $Bs = '';
-
- # we create the numbers from "patterns", e.g. get a random number and a
- # random count and string them together. This means things like
- # "100000999999999999911122222222" are much more likely. If we just strung
- # together digits, we would end up with "1272398823211223" etc. It also means
- # that we get more frequently equal numbers or other special cases.
- while (length($As) < $la) { $As .= int(rand(100)) x int(rand(16)); }
- while (length($Bs) < $lb) { $Bs .= int(rand(100)) x int(rand(16)); }
-
- $As =~ s/^0+//; $Bs =~ s/^0+//;
- $As = $As || '0'; $Bs = $Bs || '0';
-# print "# As $As\n# Bs $Bs\n";
- $A = $c->new($As); $B = $c->new($Bs);
- print "# A $A\n# B $B\n";
- if ($A->is_zero() || $B->is_zero())
- {
- for (1..4) { is (1,1, 'skipped this test'); } next;
+for (my $i = 0; $i < $count; $i++) {
+ #diag("");
+
+ # length of A and B
+ $A_len = int(rand($length) + 1);
+ $B_len = int(rand($length) + 1);
+ $A_str = '';
+ $B_str = '';
+
+ # We create the numbers from "patterns", e.g. get a random number and a
+ # random count and string them together. This means things like
+ # "100000999999999999911122222222" are much more likely. If we just strung
+ # together digits, we would end up with "1272398823211223" etc. It also
+ # means that we get more frequently equal numbers or other special cases.
+
+ while (length($A_str) < $A_len) {
+ $A_str .= int(rand(100)) x int(rand(16));
+ }
+ while (length($B_str) < $B_len) {
+ $B_str .= int(rand(100)) x int(rand(16));
}
- # check that int(A/B)*B + A % B == A holds for all inputs
+ $A_str =~ s/^0+(?=\d)//;
+ $B_str =~ s/^0+(?=\d)//;
+ #diag(" As: $A_str");
+ #diag(" Bs: $B_str");
+ $A = $class->new($A_str);
+ $B = $class->new($B_str);
+ #diag(" A: $A");
+ #diag(" B: $B");
- # $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B);
+ SKIP: {
+ skip '$A and/or $B are zero.', 4 if $A->is_zero() || $B->is_zero();
- ($ADB,$AMB) = $A->copy()->bdiv($B);
- print "# ($A / $B, $A % $B ) = $ADB $AMB\n";
+ # check that int(A / B) * B + A % B == A holds for all inputs
- print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
- "# tried $ADB * $B + $two*$AMB - $AMB\n"
- unless is ($ADB*$B+$two*$AMB-$AMB,$As, "ADB * B + 2 * AMB - AMB == A");
- if (is ($ADB*$B/$B,$ADB, "ADB * B / B == ADB"))
- {
- print "# seed: $seed, \$ADB * \$B / \$B = ", $ADB * $B / $B, " != $ADB (\$B=$B)\n";
- if (Math::BigInt->config()->{lib} =~ /::Calc/)
- {
- print "# ADB->[-1]: ", $ADB->{value}->[-1], " B->[-1]: ", $B->{value}->[-1],"\n";
- }
- }
- # swap 'em and try this, too
- # $X = ($B/$A)*$A + $B % $A;
- ($ADB,$AMB) = $B->copy()->bdiv($A);
- # print "check: $ADB $AMB";
- print "# seed $seed, ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
- "# tried $ADB * $A + $two*$AMB - $AMB\n"
- unless is ($ADB*$A+$two*$AMB-$AMB,$Bs, "ADB * A + 2 * AMB - AMB == B");
- print "# +$two * $AMB = ",$ADB * $A + $two * $AMB,"\n";
- print "# -$AMB = ",$ADB * $A + $two * $AMB - $AMB,"\n";
- print "# seed $seed, \$ADB * \$A / \$A = ", $ADB * $A / $A, " != $ADB (\$A=$A)\n"
- unless is ($ADB*$A/$A,$ADB, "ADB * A/A == ADB");
- }
+ # $X = ($A / $B) * $B + 2 * ($A % $B) - ($A % $B);
+
+ ($AdivB, $AmodB) = $A->copy()->bdiv($B);
+
+ #diag(" A / B: $AdivB");
+ #diag(" A % B: $AmodB");
+ is($AdivB * $B + $two * $AmodB - $AmodB, $A_str,
+ "AdivB * B + 2 * AmodB - AmodB == A");
+
+ if (is($AdivB * $B / $B, $AdivB, "AdivB * B / B == AdivB")) {
+ if (Math::BigInt->config()->{lib} =~ /::Calc/) {
+ #diag("AdivB->[-1]: ", $AdivB->{value}->[-1]);
+ #diag(" B->[-1]: ", $B->{value}->[-1]);
+ }
+ }
+
+ # swap 'em and try this, too
+ # $X = ($B/$A)*$A + $B % $A;
+ ($AdivB, $AmodB) = $B->copy()->bdiv($A);
+ # print "check: $AdivB $AmodB";
+
+ is($AdivB * $A + $two * $AmodB - $AmodB, $B_str,
+ "AdivB * A + 2 * AmodB - AmodB == B");
+
+ is($AdivB * $A / $A, $AdivB, "AdivB * A / A == AdivB");
+ }
+}
diff --git a/cpan/Math-BigInt/t/mbimbf.inc b/cpan/Math-BigInt/t/mbimbf.inc
index c22603ea5f..0e1a42c4f0 100644
--- a/cpan/Math-BigInt/t/mbimbf.inc
+++ b/cpan/Math-BigInt/t/mbimbf.inc
@@ -5,374 +5,537 @@
# be stringified to 123.4599999999 due to limited float prevision.
use strict;
-my ($x,$y,$z,$u,$rc);
+use warnings;
+
+my ($x, $y, $z, $u, $rc);
+our ($mbi, $mbf);
###############################################################################
# test defaults and set/get
{
- no strict 'refs';
- is (${"$mbi\::accuracy"}, undef);
- is (${"$mbi\::precision"}, undef);
- is ($mbi->accuracy(), undef);
- is ($mbi->precision(), undef);
- is (${"$mbi\::div_scale"},40);
- is (${"$mbi\::round_mode"},'even');
- is ($mbi->round_mode(),'even');
-
- is (${"$mbf\::accuracy"}, undef);
- is (${"$mbf\::precision"}, undef);
- is ($mbf->precision(), undef);
- is ($mbf->precision(), undef);
- is (${"$mbf\::div_scale"},40);
- is (${"$mbf\::round_mode"},'even');
- is ($mbf->round_mode(),'even');
+ no strict 'refs';
+ is(${"$mbi\::accuracy"}, undef, qq|\${"$mbi\::accuracy"}|);
+ is(${"$mbi\::precision"}, undef, qq|\${"$mbi\::precision"}|);
+ is($mbi->accuracy(), undef, qq|$mbi->accuracy()|);
+ is($mbi->precision(), undef, qq|$mbi->precision()|);
+ is(${"$mbi\::div_scale"}, 40, qq|\${"$mbi\::div_scale"}|);
+ is(${"$mbi\::round_mode"}, 'even', qq|\${"$mbi\::round_mode"}|);
+ is($mbi->round_mode(), 'even', qq|$mbi->round_mode()|);
+
+ is(${"$mbf\::accuracy"}, undef, qq|\${"$mbf\::accuracy"}|);
+ is(${"$mbf\::precision"}, undef, qq|\${"$mbf\::precision"}|);
+ is($mbf->precision(), undef, qq|$mbf->precision()|);
+ is($mbf->precision(), undef, qq|$mbf->precision()|);
+ is(${"$mbf\::div_scale"}, 40, qq|\${"$mbf\::div_scale"}|);
+ is(${"$mbf\::round_mode"}, 'even', qq|\${"$mbf\::round_mode"}|);
+ is($mbf->round_mode(), 'even', qq|$mbf->round_mode()|);
}
# accessors
-foreach my $class ($mbi,$mbf)
- {
- is ($class->accuracy(), undef);
- is ($class->precision(), undef);
- is ($class->round_mode(),'even');
- is ($class->div_scale(),40);
-
- is ($class->div_scale(20),20);
- $class->div_scale(40); is ($class->div_scale(),40);
-
- is ($class->round_mode('odd'),'odd');
- $class->round_mode('even'); is ($class->round_mode(),'even');
-
- is ($class->accuracy(2),2);
- $class->accuracy(3); is ($class->accuracy(),3);
- is ($class->accuracy(undef), undef);
-
- is ($class->precision(2),2);
- is ($class->precision(-2),-2);
- $class->precision(3); is ($class->precision(),3);
- is ($class->precision(undef), undef);
- }
+foreach my $class ($mbi, $mbf) {
+ is($class->accuracy(), undef, qq|$class->accuracy()|);
+ is($class->precision(), undef, qq|$class->precision()|);
+ is($class->round_mode(), "even", qq|$class->round_mode()|);
+ is($class->div_scale(), 40, qq|$class->div_scale()|);
+
+ is($class->div_scale(20), 20, qq|$class->div_scale(20)|);
+ $class->div_scale(40);
+ is($class->div_scale(), 40, qq|$class->div_scale()|);
+
+ is($class->round_mode("odd"), "odd", qq|$class->round_mode("odd")|);
+ $class->round_mode("even");
+ is($class->round_mode(), "even", qq|$class->round_mode()|);
+
+ is($class->accuracy(2), 2, qq|$class->accuracy(2)|);
+ $class->accuracy(3);
+ is($class->accuracy(), 3, qq|$class->accuracy()|);
+ is($class->accuracy(undef), undef, qq|$class->accuracy(undef)|);
+
+ is($class->precision(2), 2, qq|$class->precision(2)|);
+ is($class->precision(-2), -2, qq|$class->precision(-2)|);
+ $class->precision(3);
+ is($class->precision(), 3, qq|$class->precision()|);
+ is($class->precision(undef), undef, qq|$class->precision(undef)|);
+}
{
- no strict 'refs';
- # accuracy
- foreach (qw/5 42 -1 0/)
- {
- is (${"$mbf\::accuracy"} = $_,$_);
- is (${"$mbi\::accuracy"} = $_,$_);
+ no strict 'refs';
+
+ # accuracy
+ foreach (qw/5 42 -1 0/) {
+ is(${"$mbf\::accuracy"} = $_, $_, qq|\${"$mbf\::accuracy"} = $_|);
+ is(${"$mbi\::accuracy"} = $_, $_, qq|\${"$mbi\::accuracy"} = $_|);
}
- is (${"$mbf\::accuracy"} = undef, undef);
- is (${"$mbi\::accuracy"} = undef, undef);
-
- # precision
- foreach (qw/5 42 -1 0/)
- {
- is (${"$mbf\::precision"} = $_,$_);
- is (${"$mbi\::precision"} = $_,$_);
+ is(${"$mbf\::accuracy"} = undef, undef, qq|\${"$mbf\::accuracy"} = undef|);
+ is(${"$mbi\::accuracy"} = undef, undef, qq|\${"$mbi\::accuracy"} = undef|);
+
+ # precision
+ foreach (qw/5 42 -1 0/) {
+ is(${"$mbf\::precision"} = $_, $_, qq|\${"$mbf\::precision"} = $_|);
+ is(${"$mbi\::precision"} = $_, $_, qq|\${"$mbi\::precision"} = $_|);
}
- is (${"$mbf\::precision"} = undef, undef);
- is (${"$mbi\::precision"} = undef, undef);
-
- # fallback
- foreach (qw/5 42 1/)
- {
- is (${"$mbf\::div_scale"} = $_,$_);
- is (${"$mbi\::div_scale"} = $_,$_);
+ is(${"$mbf\::precision"} = undef, undef,
+ qq|\${"$mbf\::precision"} = undef|);
+ is(${"$mbi\::precision"} = undef, undef,
+ qq|\${"$mbi\::precision"} = undef|);
+
+ # fallback
+ foreach (qw/5 42 1/) {
+ is(${"$mbf\::div_scale"} = $_, $_, qq|\${"$mbf\::div_scale"} = $_|);
+ is(${"$mbi\::div_scale"} = $_, $_, qq|\${"$mbi\::div_scale"} = $_|);
}
- # illegal values are possible for fallback due to no accessor
-
- # round_mode
- foreach (qw/odd even zero trunc +inf -inf/)
- {
- is (${"$mbf\::round_mode"} = $_,$_);
- is (${"$mbi\::round_mode"} = $_,$_);
+ # illegal values are possible for fallback due to no accessor
+
+ # round_mode
+ foreach (qw/odd even zero trunc +inf -inf/) {
+ is(${"$mbf\::round_mode"} = $_, $_,
+ qq|\${"$mbf\::round_mode"} = "$_"|);
+ is(${"$mbi\::round_mode"} = $_, $_,
+ qq|\${"$mbi\::round_mode"} = "$_"|);
}
- ${"$mbf\::round_mode"} = 'zero';
- is (${"$mbf\::round_mode"},'zero');
- is (${"$mbi\::round_mode"},'-inf'); # from above
-
- # reset for further tests
- ${"$mbi\::accuracy"} = undef;
- ${"$mbi\::precision"} = undef;
- ${"$mbf\::div_scale"} = 40;
+ ${"$mbf\::round_mode"} = 'zero';
+ is(${"$mbf\::round_mode"}, 'zero', qq|\${"$mbf\::round_mode"}|);
+ is(${"$mbi\::round_mode"}, '-inf', qq|\${"$mbi\::round_mode"}|);
+
+ # reset for further tests
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = undef;
+ ${"$mbf\::div_scale"} = 40;
}
# local copies
$x = $mbf->new('123.456');
-is ($x->accuracy(), undef);
-is ($x->accuracy(5),5);
-is ($x->accuracy(undef),undef, undef);
-is ($x->precision(), undef);
-is ($x->precision(5),5);
-is ($x->precision(undef),undef, undef);
+is($x->accuracy(), undef, q|$x->accuracy()|);
+is($x->accuracy(5), 5, q|$x->accuracy(5)|);
+is($x->accuracy(undef), undef, q|$x->accuracy(undef)|);
+is($x->precision(), undef, q|$x->precision()|);
+is($x->precision(5), 5, q|$x->precision(5)|);
+is($x->precision(undef), undef, q|$x->precision(undef)|);
{
- no strict 'refs';
- # see if MBF changes MBIs values
- is (${"$mbi\::accuracy"} = 42,42);
- is (${"$mbf\::accuracy"} = 64,64);
- is (${"$mbi\::accuracy"},42); # should be still 42
- is (${"$mbf\::accuracy"},64); # should be now 64
+ no strict 'refs';
+ # see if MBF changes MBIs values
+ is(${"$mbi\::accuracy"} = 42, 42, qq|\${"$mbi\::accuracy"} = 42|);
+ is(${"$mbf\::accuracy"} = 64, 64, qq|\${"$mbf\::accuracy"} = 64|);
+ is(${"$mbi\::accuracy"}, 42, qq|\${"$mbi\::accuracy"} = 42|);
+ is(${"$mbf\::accuracy"}, 64, qq|\${"$mbf\::accuracy"} = 64|);
}
###############################################################################
# see if creating a number under set A or P will round it
{
- no strict 'refs';
- ${"$mbi\::accuracy"} = 4;
- ${"$mbi\::precision"} = undef;
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = 4;
+ ${"$mbi\::precision"} = undef;
- is ($mbi->new(123456),123500); # with A
- ${"$mbi\::accuracy"} = undef;
- ${"$mbi\::precision"} = 3;
- is ($mbi->new(123456),123000); # with P
+ is($mbi->new(123456), 123500, qq|$mbi->new(123456) = 123500|); # with A
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = 3;
+ is($mbi->new(123456), 123000, qq|$mbi->new(123456) = 123000|); # with P
- ${"$mbf\::accuracy"} = 4;
- ${"$mbf\::precision"} = undef;
- ${"$mbi\::precision"} = undef;
+ ${"$mbf\::accuracy"} = 4;
+ ${"$mbf\::precision"} = undef;
+ ${"$mbi\::precision"} = undef;
- is ($mbf->new('123.456'),'123.5'); # with A
- ${"$mbf\::accuracy"} = undef;
- ${"$mbf\::precision"} = -1;
- is ($mbf->new('123.456'),'123.5'); # with P from MBF, not MBI!
+ is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
+ ${"$mbf\::accuracy"} = undef;
+ ${"$mbf\::precision"} = -1;
+ is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|);
- ${"$mbf\::precision"} = undef; # reset
+ ${"$mbf\::precision"} = undef; # reset
}
###############################################################################
# see if MBI leaves MBF's private parts alone
{
- no strict 'refs';
- ${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
- ${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
- is ($mbf->new('123.456'),'123.456');
- ${"$mbi\::accuracy"} = undef; # reset
+ no strict 'refs';
+ ${"$mbi\::precision"} = undef;
+ ${"$mbf\::precision"} = undef;
+ ${"$mbi\::accuracy"} = 4;
+ ${"$mbf\::accuracy"} = undef;
+ is($mbf->new("123.456"), "123.456", qq|$mbf->new("123.456") = 123.456|);
+ ${"$mbi\::accuracy"} = undef; # reset
}
###############################################################################
# see if setting accuracy/precision actually rounds the number
-$x = $mbf->new('123.456'); $x->accuracy(4); is ($x,'123.5');
-$x = $mbf->new('123.456'); $x->precision(-2); is ($x,'123.46');
+$x = $mbf->new("123.456");
+$x->accuracy(4);
+is($x, "123.5", qq|\$x = $mbf->new("123.456"); \$x->accuracy(4)|);
-$x = $mbi->new(123456); $x->accuracy(4); is ($x,123500);
-$x = $mbi->new(123456); $x->precision(2); is ($x,123500);
+$x = $mbf->new("123.456");
+$x->precision(-2);
+is($x, "123.46", qq|\$x = $mbf->new("123.456"); \$x->precision(-2)|);
-###############################################################################
-# test actual rounding via round()
+$x = $mbi->new(123456);
+$x->accuracy(4);
+is($x, 123500, qq|\$x = $mbi->new(123456); \$x->accuracy(4)|);
-$x = $mbf->new('123.456');
-is ($x->copy()->round(5),'123.46');
-is ($x->copy()->round(4),'123.5');
-is ($x->copy()->round(5,2),'NaN');
-is ($x->copy()->round(undef,-2),'123.46');
-is ($x->copy()->round(undef,2),120);
+$x = $mbi->new(123456);
+$x->precision(2);
+is($x, 123500, qq|\$x = $mbi->new(123456); \$x->precision(2)|);
-$x = $mbi->new('123');
-is ($x->round(5,2),'NaN');
+###############################################################################
+# test actual rounding via round()
-$x = $mbf->new('123.45000');
-is ($x->copy()->round(undef,-1,'odd'),'123.5');
+$x = $mbf->new("123.456");
+is($x->copy()->round(5), "123.46",
+ qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5)|);
+is($x->copy()->round(4), "123.5",
+ qq|\$x = $mbf->new("123.456"); \$x->copy()->round(4)|);
+is($x->copy()->round(5, 2), "NaN",
+ qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5, 2)|);
+is($x->copy()->round(undef, -2), "123.46",
+ qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, -2)|);
+is($x->copy()->round(undef, 2), 120,
+ qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, 2)|);
+
+$x = $mbi->new("123");
+is($x->round(5, 2), "NaN",
+ qq|\$x = $mbi->new("123"); \$x->round(5, 2)|);
+
+$x = $mbf->new("123.45000");
+is($x->copy()->round(undef, -1, "odd"), "123.5",
+ qq|\$x = $mbf->new("123.45000"); \$x->copy()->round(undef, -1, "odd")|);
# see if rounding is 'sticky'
-$x = $mbf->new('123.4567');
+$x = $mbf->new("123.4567");
$y = $x->copy()->bround(); # no-op since nowhere A or P defined
-is ($y,123.4567);
+is($y, 123.4567,
+ qq|\$x = $mbf->new("123.4567"); \$y = \$x->copy()->bround()|);
$y = $x->copy()->round(5);
-is ($y->accuracy(),5);
-is ($y->precision(), undef); # A has precedence, so P still unset
-$y = $x->copy()->round(undef,2);
-is ($y->precision(),2);
-is ($y->accuracy(), undef); # P has precedence, so A still unset
+is($y->accuracy(), 5,
+ q|$y = $x->copy()->round(5); $y->accuracy()|);
+is($y->precision(), undef, # A has precedence, so P still unset
+ q|$y = $x->copy()->round(5); $y->precision()|);
+$y = $x->copy()->round(undef, 2);
+is($y->precision(), 2,
+ q|$y = $x->copy()->round(undef, 2); $y->precision()|);
+is($y->accuracy(), undef, # P has precedence, so A still unset
+ q|$y = $x->copy()->round(undef, 2); $y->accuracy()|);
# see if setting A clears P and vice versa
-$x = $mbf->new('123.4567');
-is ($x,'123.4567');
-is ($x->accuracy(4),4);
-is ($x->precision(-2),-2); # clear A
-is ($x->accuracy(), undef);
-
-$x = $mbf->new('123.4567');
-is ($x,'123.4567');
-is ($x->precision(-2),-2);
-is ($x->accuracy(4),4); # clear P
-is ($x->precision(), undef);
+$x = $mbf->new("123.4567");
+is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
+is($x->accuracy(4), 4, q|$x->accuracy(4)|);
+is($x->precision(-2), -2, q|$x->precision(-2)|); # clear A
+is($x->accuracy(), undef, q|$x->accuracy()|);
+
+$x = $mbf->new("123.4567");
+is($x, "123.4567", q|$x = $mbf->new("123.4567")|);
+is($x->precision(-2), -2, q|$x->precision(-2)|);
+is($x->accuracy(4), 4, q|$x->accuracy(4)|); # clear P
+is($x->precision(), undef, q|$x->precision()|);
# does copy work?
-$x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2);
-$z = $x->copy(); is ($z->accuracy(),undef); is ($z->precision(),2);
+$x = $mbf->new(123.456);
+$x->accuracy(4);
+$x->precision(2);
-# does $x->bdiv($y,d) work when $d > div_scale?
-$x = $mbf->new('0.008'); $x->accuracy(8);
+$z = $x->copy();
+is($z->accuracy(), undef, q|$z = $x->copy(); $z->accuracy()|);
+is($z->precision(), 2, q|$z = $x->copy(); $z->precision()|);
-for my $e ( 4, 8, 16, 32 )
- {
- print "# Tried: $x->bdiv(3,$e)\n"
- unless is (scalar $x->copy()->bdiv(3,$e), '0.002' . ('6' x ($e-2)) . '7');
- }
+# does $x->bdiv($y, d) work when $d > div_scale?
+$x = $mbf->new("0.008");
+$x->accuracy(8);
+
+for my $e (4, 8, 16, 32) {
+ is(scalar $x->copy()->bdiv(3, $e), "0.002" . ("6" x ($e - 2)) . "7",
+ qq|\$x->copy()->bdiv(3, $e)|);
+}
# does accuracy()/precision work on zeros?
-foreach my $c ($mbi,$mbf)
- {
- $x = $c->bzero(); $x->accuracy(5); is ($x->{_a},5);
- $x = $c->bzero(); $x->precision(5); is ($x->{_p},5);
- $x = $c->new(0); $x->accuracy(5); is ($x->{_a},5);
- $x = $c->new(0); $x->precision(5); is ($x->{_p},5);
-
- $x = $c->bzero(); $x->round(5); is ($x->{_a},5);
- $x = $c->bzero(); $x->round(undef,5); is ($x->{_p},5);
- $x = $c->new(0); $x->round(5); is ($x->{_a},5);
- $x = $c->new(0); $x->round(undef,5); is ($x->{_p},5);
-
- # see if trying to increasing A in bzero() doesn't do something
- $x = $c->bzero(); $x->{_a} = 3; $x->round(5); is ($x->{_a},3);
- }
+foreach my $class ($mbi, $mbf) {
+
+ $x = $class->bzero();
+ $x->accuracy(5);
+ is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{_a}|);
+
+ $x = $class->bzero();
+ $x->precision(5);
+ is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->precision(5); \$x->{_p}|);
+
+ $x = $class->new(0);
+ $x->accuracy(5);
+ is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->accuracy(5); \$x->{_a}|);
+
+ $x = $class->new(0);
+ $x->precision(5);
+ is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->precision(5); \$x->{_p}|);
+
+ $x = $class->bzero();
+ $x->round(5);
+ is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->round(5); \$x->{_a}|);
+
+ $x = $class->bzero();
+ $x->round(undef, 5);
+ is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->round(undef, 5); \$x->{_p}|);
+
+ $x = $class->new(0);
+ $x->round(5);
+ is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->round(5); \$x->{_a}|);
+
+ $x = $class->new(0);
+ $x->round(undef, 5);
+ is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->round(undef, 5); \$x->{_p}|);
+
+ # see if trying to increasing A in bzero() doesn't do something
+ $x = $class->bzero();
+ $x->{_a} = 3;
+ $x->round(5);
+ is($x->{_a}, 3,
+ qq|\$x = $class->bzero(); \$x->{_a} = 3; \$x->round(5); \$x->{_a}|);
+}
###############################################################################
# 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())
-foreach my $c ($mbi,$mbf)
- {
-# ${"$c\::precision"} = undef; # reset
-# ${"$c\::accuracy"} = undef; # reset
-
- is ($c->new(123)->badd(123),246);
- is ($c->badd(123,321),444);
- is ($c->badd(123,$c->new(321)),444);
-
- is ($c->new(123)->bsub(122),1);
- is ($c->bsub(321,123),198);
- is ($c->bsub(321,$c->new(123)),198);
+foreach my $class ($mbi, $mbf) {
+ # ${"$class\::precision"} = undef; # reset
+ # ${"$class\::accuracy"} = undef; # reset
+
+ is($class->new(123)->badd(123), 246, qq|$class->new(123)->badd(123)|);
+ is($class->badd(123, 321), 444, qq|$class->badd(123, 321)|);
+ is($class->badd(123, $class->new(321)), 444,
+ qq|$class->badd(123, $class->new(321))|);
+
+ is($class->new(123)->bsub(122), 1, qq|$class->new(123)->bsub(122)|);
+ is($class->bsub(321, 123), 198, qq|$class->bsub(321, 123)|);
+ is($class->bsub(321, $class->new(123)), 198,
+ qq|$class->bsub(321, $class->new(123))|);
+
+ is($class->new(123)->bmul(123), 15129, qq|$class->new(123)->bmul(123)|);
+ is($class->bmul(123, 123), 15129, qq|$class->bmul(123, 123)|);
+ is($class->bmul(123, $class->new(123)), 15129,
+ qq|$class->bmul(123, $class->new(123))|);
+
+ # is($class->new(15129)->bdiv(123), 123, qq|$class->new(15129)->bdiv(123)|);
+ # is($class->bdiv(15129, 123), 123, qq|$class->bdiv(15129, 123)|);
+ # is($class->bdiv(15129, $class->new(123)), 123,
+ # qq|$class->bdiv(15129, $class->new(123))|);
+
+ is($class->new(15131)->bmod(123), 2, qq|$class->new(15131)->bmod(123)|);
+ is($class->bmod(15131, 123), 2, qq|$class->bmod(15131, 123)|);
+ is($class->bmod(15131, $class->new(123)), 2,
+ qq|$class->bmod(15131, $class->new(123))|);
+
+ is($class->new(2)->bpow(16), 65536, qq|$class->new(2)->bpow(16)|);
+ is($class->bpow(2, 16), 65536, qq|$class->bpow(2, 16)|);
+ is($class->bpow(2, $class->new(16)), 65536,
+ qq|$class->bpow(2, $class->new(16))|);
+
+ is($class->new(2**15)->brsft(1), 2**14, qq|$class->new(2**15)->brsft(1)|);
+ is($class->brsft(2**15, 1), 2**14, qq|$class->brsft(2**15, 1)|);
+ is($class->brsft(2**15, $class->new(1)), 2**14,
+ qq|$class->brsft(2**15, $class->new(1))|);
+
+ is($class->new(2**13)->blsft(1), 2**14, qq|$class->new(2**13)->blsft(1)|);
+ is($class->blsft(2**13, 1), 2**14, qq|$class->blsft(2**13, 1)|);
+ is($class->blsft(2**13, $class->new(1)), 2**14,
+ qq|$class->blsft(2**13, $class->new(1))|);
+}
- is ($c->new(123)->bmul(123),15129);
- is ($c->bmul(123,123),15129);
- is ($c->bmul(123,$c->new(123)),15129);
+###############################################################################
+# Test whether operations round properly afterwards.
+# These tests are not complete, since they do not exercise every "return"
+# statement in the op's. But heh, it's better than nothing...
-# is ($c->new(15129)->bdiv(123),123);
-# is ($c->bdiv(15129,123),123);
-# is ($c->bdiv(15129,$c->new(123)),123);
+$x = $mbf->new("123.456");
+$y = $mbf->new("654.321");
+$x->{_a} = 5; # $x->accuracy(5) would round $x straight away
+$y->{_a} = 4; # $y->accuracy(4) would round $x straight away
- is ($c->new(15131)->bmod(123),2);
- is ($c->bmod(15131,123),2);
- is ($c->bmod(15131,$c->new(123)),2);
+$z = $x + $y;
+is($z, "777.8", q|$z = $x + $y|);
- is ($c->new(2)->bpow(16),65536);
- is ($c->bpow(2,16),65536);
- is ($c->bpow(2,$c->new(16)),65536);
+$z = $y - $x;
+is($z, "530.9", q|$z = $y - $x|);
- is ($c->new(2**15)->brsft(1),2**14);
- is ($c->brsft(2**15,1),2**14);
- is ($c->brsft(2**15,$c->new(1)),2**14);
+$z = $y * $x;
+is($z, "80780", q|$z = $y * $x|);
- is ($c->new(2**13)->blsft(1),2**14);
- is ($c->blsft(2**13,1),2**14);
- is ($c->blsft(2**13,$c->new(1)),2**14);
- }
+$z = $x ** 2;
+is($z, "15241", q|$z = $x ** 2|);
-###############################################################################
-# test whether operations round properly afterwards
-# These tests are not complete, since they do not exercise every "return"
-# statement in the op's. But heh, it's better than nothing...
+$z = $x * $x;
+is($z, "15241", q|$z = $x * $x|);
-$x = $mbf->new('123.456');
-$y = $mbf->new('654.321');
-$x->{_a} = 5; # $x->accuracy(5) would round $x straight away
-$y->{_a} = 4; # $y->accuracy(4) would round $x straight away
+# not:
+#$z = -$x;
+#is($z, '-123.46');
+#is($x, '123.456');
-$z = $x + $y; is ($z,'777.8');
-$z = $y - $x; is ($z,'530.9');
-$z = $y * $x; is ($z,'80780');
-$z = $x ** 2; is ($z,'15241');
-$z = $x * $x; is ($z,'15241');
+$z = $x->copy();
+$z->{_a} = 2;
+$z = $z / 2;
+is($z, 62, q|$z = $z / 2|);
-# not: $z = -$x; is ($z,'-123.46'); is ($x,'123.456');
-$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is ($z,62);
-$x = $mbf->new(123456); $x->{_a} = 4;
-$z = $x->copy; $z++; is ($z,123500);
+$x = $mbf->new(123456);
+$x->{_a} = 4;
+$z = $x->copy;
+$z++;
+is($z, 123500, q|$z++|);
$x = $mbi->new(123456);
$y = $mbi->new(654321);
$x->{_a} = 5; # $x->accuracy(5) would round $x straight away
$y->{_a} = 4; # $y->accuracy(4) would round $x straight away
-$z = $x + $y; is ($z,777800);
-$z = $y - $x; is ($z,530900);
-$z = $y * $x; is ($z,80780000000);
-$z = $x ** 2; is ($z,15241000000);
-# not yet: $z = -$x; is ($z,-123460); is ($x,123456);
-$z = $x->copy; $z++; is ($z,123460);
-$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is ($z,62000);
+$z = $x + $y;
+is($z, 777800, q|$z = $x + $y|);
-$x = $mbi->new(123400); $x->{_a} = 4;
-is ($x->bnot(),-123400); # not -1234001
+$z = $y - $x;
+is($z, 530900, q|$z = $y - $x|);
+
+$z = $y * $x;
+is($z, 80780000000, q|$z = $y * $x|);
+
+$z = $x ** 2;
+is($z, 15241000000, q|$z = $x ** 2|);
+
+# not yet: $z = -$x;
+# is($z, -123460, qq|$z|);
+# is($x, 123456, qq|$x|);
+
+$z = $x->copy;
+$z++;
+is($z, 123460, q|$z++|);
+
+$z = $x->copy();
+$z->{_a} = 2;
+$z = $z / 2;
+is($z, 62000, q|$z = $z / 2|);
+
+$x = $mbi->new(123400);
+$x->{_a} = 4;
+is($x->bnot(), -123400, q|$x->bnot()|); # not -1234001
# both babs() and bneg() don't need to round, since the input will already
# be rounded (either as $x or via new($string)), and they don't change the
# value. The two tests below peek at this by using _a (illegally) directly
-$x = $mbi->new(-123401); $x->{_a} = 4; is ($x->babs(),123401);
-$x = $mbi->new(-123401); $x->{_a} = 4; is ($x->bneg(),123401);
-
-# test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
-$mbf->round_mode('even');
-$x = $mbf->new('740.7')->bdiv('6',4,undef,'zero'); is ($x,'123.4');
-$x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6;
-is ($x->bdiv($y),1); is ($x->{_a},6); # carried over
+$x = $mbi->new(-123401);
+$x->{_a} = 4;
+is($x->babs(), 123401, q|$x->babs()|);
-$x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6;
-is ($x->bdiv($y),1); is ($x->{_a},6); # carried over
+$x = $mbi->new(-123401);
+$x->{_a} = 4;
+is($x->bneg(), 123401, q|$x->bneg()|);
-$x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6;
-is ($x->bdiv($y),0); is ($x->{_a},6); # carried over
+# test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
-$x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6;
-is ($x->bdiv($y),0); is ($x->{_a},6); # carried over
+$mbf->round_mode('even');
+$x = $mbf->new('740.7')->bdiv('6', 4, undef, 'zero');
+is($x, '123.4', q|$x|);
+
+$x = $mbi->new('123456');
+$y = $mbi->new('123456');
+$y->{_a} = 6;
+is($x->bdiv($y), 1, q|$x->bdiv($y)|);
+is($x->{_a}, 6, q|$x->{_a}|); # carried over
+
+$x = $mbi->new('123456');
+$y = $mbi->new('123456');
+$x->{_a} = 6;
+is($x->bdiv($y), 1, q|$x->bdiv($y)|);
+is($x->{_a}, 6, q|$x->{_a}|); # carried over
+
+$x = $mbi->new('123456');
+$y = $mbi->new('223456');
+$y->{_a} = 6;
+is($x->bdiv($y), 0, q|$x->bdiv($y)|);
+is($x->{_a}, 6, q|$x->{_a}|); # carried over
+
+$x = $mbi->new('123456');
+$y = $mbi->new('223456');
+$x->{_a} = 6;
+is($x->bdiv($y), 0, q|$x->bdiv($y)|);
+is($x->{_a}, 6, q|$x->{_a}|); # carried over
###############################################################################
# test that bop(0) does the same than bop(undef)
$x = $mbf->new('1234567890');
-is ($x->copy()->bsqrt(0),$x->copy()->bsqrt(undef));
-is ($x->copy->bsqrt(0),'35136.41828644462161665823116758077037159');
+is($x->copy()->bsqrt(0), $x->copy()->bsqrt(undef),
+ q|$x->copy()->bsqrt(...)|);
+is($x->copy->bsqrt(0), '35136.41828644462161665823116758077037159',
+ q|$x->copy->bsqrt(...)|);
-is ($x->{_a}, undef);
+is($x->{_a}, undef, q|$x->{_a}|);
# test that bsqrt() modifies $x and does not just return something else
-# (especially under BareCalc)
+# (especially under Math::BigInt::BareCalc)
$z = $x->bsqrt();
-is ($z,$x); is ($x,'35136.41828644462161665823116758077037159');
+is($z, $x, q|$z = $x->bsqrt(); $z|);
+is($x, '35136.41828644462161665823116758077037159', q|$z = $x->bsqrt(); $x|);
$x = $mbf->new('1.234567890123456789');
-is ($x->copy()->bpow('0.5',0),$x->copy()->bpow('0.5',undef));
-is ($x->copy()->bpow('0.5',0),$x->copy()->bsqrt(undef));
-is ($x->copy()->bpow('2',0),'1.524157875323883675019051998750190521');
+
+is($x->copy()->bpow('0.5', 0),
+ $x->copy()->bpow('0.5', undef),
+ q|$x->copy()->bpow(...)|);
+
+is($x->copy()->bpow('0.5', 0),
+ $x->copy()->bsqrt(undef),
+ q|$x->copy()->bpow(...) vs. $x->copy()->bsqrt(...)|);
+
+is($x->copy()->bpow('2', 0), '1.524157875323883675019051998750190521',
+ q|$x->copy()->bpow('2', 0)|);
###############################################################################
# test (also under Bare) that bfac() rounds at last step
-is ($mbi->new(12)->bfac(),'479001600');
-is ($mbi->new(12)->bfac(2),'480000000');
-$x = $mbi->new(12); $x->accuracy(2); is ($x->bfac(),'480000000');
-$x = $mbi->new(13); $x->accuracy(2); is ($x->bfac(),'6200000000');
-$x = $mbi->new(13); $x->accuracy(3); is ($x->bfac(),'6230000000');
-$x = $mbi->new(13); $x->accuracy(4); is ($x->bfac(),'6227000000');
-# this does 1,2,3...9,10,11,12...20
-$x = $mbi->new(20); $x->accuracy(1); is ($x->bfac(),'2000000000000000000');
+is($mbi->new(12)->bfac(), '479001600', q|$mbi->new(12)->bfac()|);
+is($mbi->new(12)->bfac(2), '480000000', q|$mbi->new(12)->bfac(2)|);
+
+$x = $mbi->new(12);
+$x->accuracy(2);
+is($x->bfac(), '480000000',
+ qq|\$x = $mbi->new(12); \$x->accuracy(2); \$x->bfac()|);
+
+$x = $mbi->new(13);
+$x->accuracy(2);
+is($x->bfac(), '6200000000',
+ qq|\$x = $mbi->new(13); \$x->accuracy(2); \$x->bfac()|);
+
+$x = $mbi->new(13);
+$x->accuracy(3);
+is($x->bfac(), '6230000000',
+ qq|\$x = $mbi->new(13); \$x->accuracy(3); \$x->bfac()|);
+
+$x = $mbi->new(13);
+$x->accuracy(4);
+is($x->bfac(), '6227000000',
+ qq|\$x = $mbi->new(13); \$x->accuracy(4); \$x->bfac()|);
+
+# this does 1, 2, 3...9, 10, 11, 12...20
+$x = $mbi->new(20);
+$x->accuracy(1);
+is($x->bfac(), '2000000000000000000',
+ qq|\$x = $mbi->new(20); \$x->accuracy(1); \$x->bfac()|);
###############################################################################
# test bsqrt) rounding to given A/P/R (bug prior to v1.60)
-$x = $mbi->new('123456')->bsqrt(2,undef); is ($x,'350'); # not 351
-$x = $mbi->new('3')->bsqrt(2,undef); is ($x->accuracy(),2);
-$mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2,undef,'+inf');
-is ($x,'360'); # not 355 nor 350
+$x = $mbi->new('123456')->bsqrt(2, undef);
+is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351
+
+$x = $mbi->new('3')->bsqrt(2, undef);
+is($x->accuracy(), 2, q|$x->accuracy()|);
-$x = $mbi->new('126025')->bsqrt(undef,2); is ($x,'400'); # not 355
+$mbi->round_mode('even');
+$x = $mbi->new('126025')->bsqrt(2, undef, '+inf');
+is($x, '360', q|$x = 360|); # not 355 nor 350
+$x = $mbi->new('126025')->bsqrt(undef, 2);
+is($x, '400', q|$x = 400|); # not 355
###############################################################################
# test mixed arguments
@@ -381,491 +544,675 @@ $x = $mbf->new(10);
$u = $mbf->new(2.5);
$y = $mbi->new(2);
-$z = $x + $y; is ($z,12); is (ref($z),$mbf);
-$z = $x / $y; is ($z,5); is (ref($z),$mbf);
-$z = $u * $y; is ($z,5); is (ref($z),$mbf);
+$z = $x + $y;
+is($z, 12, q|$z = $x + $y;|);
+is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
+
+$z = $x / $y;
+is($z, 5, q|$z = $x / $y;|);
+is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
+
+$z = $u * $y;
+is($z, 5, q|$z = $u * $y;|);
+is(ref($z), $mbf, qq|\$z is a "$mbf" object|);
$y = $mbi->new(12345);
-$z = $u->copy()->bmul($y,2,undef,'odd'); is ($z,31000);
-$z = $u->copy()->bmul($y,3,undef,'odd'); is ($z,30900);
-$z = $u->copy()->bmul($y,undef,0,'odd'); is ($z,30863);
-$z = $u->copy()->bmul($y,undef,1,'odd'); is ($z,30863);
-$z = $u->copy()->bmul($y,undef,2,'odd'); is ($z,30860);
-$z = $u->copy()->bmul($y,undef,3,'odd'); is ($z,30900);
-$z = $u->copy()->bmul($y,undef,-1,'odd'); is ($z,30862.5);
-
-my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
-# these should no longer warn, even tho '3.17' is a NaN in BigInt (>= returns
-# now false, bug until v1.80)
-$warn = ''; eval "\$z = 3.17 <= \$y"; is ($z, '');
-unlike ($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/);
-$warn = ''; eval "\$z = \$y >= 3.17"; is ($z, '');
-unlike ($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/);
+$z = $u->copy()->bmul($y, 2, undef, 'odd');
+is($z, 31000, q|$z = 31000|);
+
+$z = $u->copy()->bmul($y, 3, undef, 'odd');
+is($z, 30900, q|$z = 30900|);
+
+$z = $u->copy()->bmul($y, undef, 0, 'odd');
+is($z, 30863, q|$z = 30863|);
+
+$z = $u->copy()->bmul($y, undef, 1, 'odd');
+is($z, 30863, q|$z = 30863|);
+
+$z = $u->copy()->bmul($y, undef, 2, 'odd');
+is($z, 30860, q|$z = 30860|);
+
+$z = $u->copy()->bmul($y, undef, 3, 'odd');
+is($z, 30900, q|$z = 30900|);
+
+$z = $u->copy()->bmul($y, undef, -1, 'odd');
+is($z, 30862.5, q|$z = 30862.5|);
+
+my $warn = '';
+$SIG{__WARN__} = sub { $warn = shift; };
+
+# These should no longer warn, even though '3.17' is a NaN in Math::BigInt
+# (>= returns now false, bug until v1.80).
+
+$warn = '';
+eval '$z = 3.17 <= $y';
+is($z, '', q|$z = ""|);
+unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/,
+ q|"$z = $y >= 3.17" gives warning as expected|);
+
+$warn = '';
+eval '$z = $y >= 3.17';
+is($z, '', q|$z = ""|);
+unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/,
+ q|"$z = $y >= 3.17" gives warning as expected|);
# XXX TODO breakage:
-# $z = $y->copy()->bmul($u,2,0,'odd'); is ($z,31000);
-# $z = $y * $u; is ($z,5); is (ref($z),$mbi);
-# $z = $y + $x; is ($z,12); is (ref($z),$mbi);
-# $z = $y / $x; is ($z,0); is (ref($z),$mbi);
+#
+# $z = $y->copy()->bmul($u, 2, 0, 'odd');
+# is($z, 31000);
+#
+# $z = $y * $u;
+# is($z, 5);
+# is(ref($z), $mbi, q|\$z is a $mbi object|);
+#
+# $z = $y + $x;
+# is($z, 12);
+# is(ref($z), $mbi, q|\$z is a $mbi object|);
+#
+# $z = $y / $x;
+# is($z, 0);
+# is(ref($z), $mbi, q|\$z is a $mbi object|);
###############################################################################
# rounding in bdiv with fallback and already set A or P
{
- no strict 'refs';
- ${"$mbf\::accuracy"} = undef;
- ${"$mbf\::precision"} = undef;
- ${"$mbf\::div_scale"} = 40;
+ no strict 'refs';
+ ${"$mbf\::accuracy"} = undef;
+ ${"$mbf\::precision"} = undef;
+ ${"$mbf\::div_scale"} = 40;
}
- $x = $mbf->new(10); $x->{_a} = 4;
- is ($x->bdiv(3),'3.333');
- is ($x->{_a},4); # set's it since no fallback
+$x = $mbf->new(10);
+$x->{_a} = 4;
+is($x->bdiv(3), '3.333', q|$x->bdiv(3)|);
+is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback
-$x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
-is ($x->bdiv($y),'3.333');
-is ($x->{_a},4); # set's it since no fallback
+$x = $mbf->new(10);
+$x->{_a} = 4;
+$y = $mbf->new(3);
+is($x->bdiv($y), '3.333', q|$x->bdiv($y)|);
+is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback
# rounding to P of x
-$x = $mbf->new(10); $x->{_p} = -2;
-is ($x->bdiv(3),'3.33');
+$x = $mbf->new(10);
+$x->{_p} = -2;
+is($x->bdiv(3), '3.33', q|$x->bdiv(3)|);
# round in div with requested P
$x = $mbf->new(10);
-is ($x->bdiv(3,undef,-2),'3.33');
+is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|);
# round in div with requested P greater than fallback
{
- no strict 'refs';
- ${"$mbf\::div_scale"} = 5;
- $x = $mbf->new(10);
- is ($x->bdiv(3,undef,-8),'3.33333333');
- ${"$mbf\::div_scale"} = 40;
+ no strict 'refs';
+ ${"$mbf\::div_scale"} = 5;
+ $x = $mbf->new(10);
+ is($x->bdiv(3, undef, -8), "3.33333333",
+ q|$x->bdiv(3, undef, -8) = "3.33333333"|);
+ ${"$mbf\::div_scale"} = 40;
}
-$x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4;
-is ($x->bdiv($y),'3.333');
-is ($x->{_a},4); is ($y->{_a},4); # set's it since no fallback
-is ($x->{_p}, undef); is ($y->{_p}, undef);
+$x = $mbf->new(10);
+$y = $mbf->new(3);
+$y->{_a} = 4;
+is($x->bdiv($y), '3.333', q|$x->bdiv($y) = '3.333'|);
+is($x->{_a}, 4, q|$x->{_a} = 4|);
+is($y->{_a}, 4, q|$y->{_a} = 4|); # set's it since no fallback
+is($x->{_p}, undef, q|$x->{_p} = undef|);
+is($y->{_p}, undef, q|$y->{_p} = undef|);
# rounding to P of y
-$x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2;
-is ($x->bdiv($y),'3.33');
-is ($x->{_p},-2);
- is ($y->{_p},-2);
-is ($x->{_a}, undef); is ($y->{_a}, undef);
+$x = $mbf->new(10);
+$y = $mbf->new(3);
+$y->{_p} = -2;
+is($x->bdiv($y), '3.33', q|$x->bdiv($y) = '3.33'|);
+is($x->{_p}, -2, q|$x->{_p} = -2|);
+ is($y->{_p}, -2, q|$y->{_p} = -2|);
+is($x->{_a}, undef, q|$x->{_a} = undef|);
+is($y->{_a}, undef, q|$y->{_a} = undef|);
###############################################################################
# test whether bround(-n) fails in MBF (undocumented in MBI)
-eval { $x = $mbf->new(1); $x->bround(-2); };
-like ($@, qr/^bround\(\) needs positive accuracy/);
+eval { $x = $mbf->new(1);
+ $x->bround(-2);
+ };
+like($@, qr/^bround\(\) needs positive accuracy/,
+ qq|"\$x->bround(-2)" gives warning as expected|);
# test whether rounding to higher accuracy is no-op
-$x = $mbf->new(1); $x->{_a} = 4;
-is ($x,'1.000');
+$x = $mbf->new(1);
+$x->{_a} = 4;
+is($x, "1.000", q|$x = "1.000"|);
$x->bround(6); # must be no-op
-is ($x->{_a},4);
-is ($x,'1.000');
+is($x->{_a}, 4, q|$x->{_a} = 4|);
+is($x, "1.000", q|$x = "1.000"|);
-$x = $mbi->new(1230); $x->{_a} = 3;
-is ($x,'1230');
+$x = $mbi->new(1230);
+$x->{_a} = 3;
+is($x, "1230", q|$x = "1230"|);
$x->bround(6); # must be no-op
-is ($x->{_a},3);
-is ($x,'1230');
+is($x->{_a}, 3, q|$x->{_a} = 3|);
+is($x, "1230", q|$x = "1230"|);
# bround(n) should set _a
$x->bround(2); # smaller works
-is ($x,'1200');
-is ($x->{_a},2);
-
+is($x, "1200", q|$x = "1200"|);
+is($x->{_a}, 2, q|$x->{_a} = 2|);
+
# bround(-n) is undocumented and only used by MBF
# bround(-n) should set _a
$x = $mbi->new(12345);
$x->bround(-1);
-is ($x,'12300');
-is ($x->{_a},4);
-
+is($x, "12300", q|$x = "12300"|);
+is($x->{_a}, 4, q|$x->{_a} = 4|);
+
# bround(-n) should set _a
$x = $mbi->new(12345);
$x->bround(-2);
-is ($x,'12000');
-is ($x->{_a},3);
-
+is($x, "12000", q|$x = "12000"|);
+is($x->{_a}, 3, q|$x->{_a} = 3|);
+
# bround(-n) should set _a
-$x = $mbi->new(12345); $x->{_a} = 5;
+$x = $mbi->new(12345);
+$x->{_a} = 5;
$x->bround(-3);
-is ($x,'10000');
-is ($x->{_a},2);
-
+is($x, "10000", q|$x = "10000"|);
+is($x->{_a}, 2, q|$x->{_a} = 2|);
+
# bround(-n) should set _a
-$x = $mbi->new(12345); $x->{_a} = 5;
+$x = $mbi->new(12345);
+$x->{_a} = 5;
$x->bround(-4);
-is ($x,'0');
-is ($x->{_a},1);
+is($x, "0", q|$x = "0"|);
+is($x->{_a}, 1, q|$x->{_a} = 1|);
-# bround(-n) should be noop if n too big
+# bround(-n) should be no-op if n too big
$x = $mbi->new(12345);
$x->bround(-5);
-is ($x,'0'); # scale to "big" => 0
-is ($x->{_a},0);
-
-# bround(-n) should be noop if n too big
+is($x, "0", q|$x = "0"|); # scale to "big" => 0
+is($x->{_a}, 0, q|$x->{_a} = 0|);
+
+# bround(-n) should be no-op if n too big
$x = $mbi->new(54321);
$x->bround(-5);
-is ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000
-is ($x->{_a},0);
-
-# bround(-n) should be noop if n too big
-$x = $mbi->new(54321); $x->{_a} = 5;
+is($x, "100000", q|$x = "100000"|); # used by MBF to round 0.0054321 at 0.0_6_00000
+is($x->{_a}, 0, q|$x->{_a} = 0|);
+
+# bround(-n) should be no-op if n too big
+$x = $mbi->new(54321);
+$x->{_a} = 5;
$x->bround(-6);
-is ($x,'100000'); # no-op
-is ($x->{_a},0);
-
-# bround(n) should set _a
-$x = $mbi->new(12345); $x->{_a} = 5;
-$x->bround(5); # must be no-op
-is ($x,'12345');
-is ($x->{_a},5);
-
-# bround(n) should set _a
-$x = $mbi->new(12345); $x->{_a} = 5;
-$x->bround(6); # must be no-op
-is ($x,'12345');
+is($x, "100000", q|$x = "100000"|); # no-op
+is($x->{_a}, 0, q|$x->{_a} = 0|);
-$x = $mbf->new('0.0061'); $x->bfround(-2); is ($x,'0.01');
-$x = $mbf->new('0.004'); $x->bfround(-2); is ($x,'0.00');
-$x = $mbf->new('0.005'); $x->bfround(-2); is ($x,'0.00');
+# bround(n) should set _a
+$x = $mbi->new(12345);
+$x->{_a} = 5;
+$x->bround(5); # must be no-op
+is($x, "12345", q|$x = "12345"|);
+is($x->{_a}, 5, q|$x->{_a} = 5|);
-$x = $mbf->new('12345'); $x->bfround(2); is ($x,'12340');
-$x = $mbf->new('12340'); $x->bfround(2); is ($x,'12340');
+# bround(n) should set _a
+$x = $mbi->new(12345);
+$x->{_a} = 5;
+$x->bround(6); # must be no-op
+is($x, "12345", q|$x = "12345"|);
+
+$x = $mbf->new("0.0061");
+$x->bfround(-2);
+is($x, "0.01", q|$x = "0.01"|);
+$x = $mbf->new("0.004");
+$x->bfround(-2);
+is($x, "0.00", q|$x = "0.00"|);
+$x = $mbf->new("0.005");
+$x->bfround(-2);
+is($x, "0.00", q|$x = "0.00"|);
+
+$x = $mbf->new("12345");
+$x->bfround(2);
+is($x, "12340", q|$x = "12340"|);
+$x = $mbf->new("12340");
+$x->bfround(2);
+is($x, "12340", q|$x = "12340"|);
# MBI::bfround should clear A for negative P
-$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
-is ($x->{_a}, undef);
+$x = $mbi->new("1234");
+$x->accuracy(3);
+$x->bfround(-2);
+is($x->{_a}, undef, q|$x->{_a} = undef|);
# test that bfround() and bround() work with large numbers
-$x = $mbf->new(1)->bdiv(5678,undef,-63);
-is ($x, '0.000176118351532229658330398027474462839027826699542092286016203');
+$x = $mbf->new(1)->bdiv(5678, undef, -63);
+is($x, "0.000176118351532229658330398027474462839027826699542092286016203",
+ q|$x = "0.000176118351532229658330398027474462839027826699542092286016203"|);
-$x = $mbf->new(1)->bdiv(5678,undef,-90);
-is ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651');
+$x = $mbf->new(1)->bdiv(5678, undef, -90);
+is($x, "0.00017611835153222965833039802747446283902782"
+ . "6699542092286016202888340965128566396618527651",
+ q|$x = "0.00017611835153222965833039802747446283902782|
+ . q|6699542092286016202888340965128566396618527651"|);
-$x = $mbf->new(1)->bdiv(5678,80);
-is ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662');
+$x = $mbf->new(1)->bdiv(5678, 80);
+is($x, "0.00017611835153222965833039802747446283902782"
+ . "669954209228601620288834096512856639662",
+ q|$x = "0.00017611835153222965833039802747446283902782|
+ . q|669954209228601620288834096512856639662"|);
###############################################################################
# rounding with already set precision/accuracy
-$x = $mbf->new(1); $x->{_p} = -5;
-is ($x,'1.00000');
+$x = $mbf->new(1);
+$x->{_p} = -5;
+is($x, "1.00000", q|$x = "1.00000"|);
# further rounding donw
-is ($x->bfround(-2),'1.00');
-is ($x->{_p},-2);
+is($x->bfround(-2), "1.00", q|$x->bfround(-2) = "1.00"|);
+is($x->{_p}, -2, q|$x->{_p} = -2|);
-$x = $mbf->new(12345); $x->{_a} = 5;
-is ($x->bround(2),'12000');
-is ($x->{_a},2);
+$x = $mbf->new(12345);
+$x->{_a} = 5;
+is($x->bround(2), "12000", q|$x->bround(2) = "12000"|);
+is($x->{_a}, 2, q|$x->{_a} = 2|);
-$x = $mbf->new('1.2345'); $x->{_a} = 5;
-is ($x->bround(2),'1.2');
-is ($x->{_a},2);
+$x = $mbf->new("1.2345");
+$x->{_a} = 5;
+is($x->bround(2), "1.2", q|$x->bround(2) = "1.2"|);
+is($x->{_a}, 2, q|$x->{_a} = 2|);
# mantissa/exponent format and A/P
-$x = $mbf->new('12345.678'); $x->accuracy(4);
-is ($x,'12350'); is ($x->{_a},4); is ($x->{_p}, undef);
+$x = $mbf->new("12345.678");
+$x->accuracy(4);
+is($x, "12350", q|$x = "12350"|);
+is($x->{_a}, 4, q|$x->{_a} = 4|);
+is($x->{_p}, undef, q|$x->{_p} = undef|);
-#is ($x->{_m}->{_a}, undef); is ($x->{_e}->{_a}, undef);
-#is ($x->{_m}->{_p}, undef); is ($x->{_e}->{_p}, undef);
+#is($x->{_m}->{_a}, undef, q|$x->{_m}->{_a} = undef|);
+#is($x->{_e}->{_a}, undef, q|$x->{_e}->{_a} = undef|);
+#is($x->{_m}->{_p}, undef, q|$x->{_m}->{_p} = undef|);
+#is($x->{_e}->{_p}, undef, q|$x->{_e}->{_p} = undef|);
# check for no A/P in case of fallback
# result
$x = $mbf->new(100) / 3;
-is ($x->{_a}, undef); is ($x->{_p}, undef);
+is($x->{_a}, undef, q|$x->{_a} = undef|);
+is($x->{_p}, undef, q|$x->{_p} = undef|);
# result & remainder
-$x = $mbf->new(100) / 3; ($x,$y) = $x->bdiv(3);
-is ($x->{_a}, undef); is ($x->{_p}, undef);
-is ($y->{_a}, undef); is ($y->{_p}, undef);
+$x = $mbf->new(100) / 3;
+($x, $y) = $x->bdiv(3);
+is($x->{_a}, undef, q|$x->{_a} = undef|);
+is($x->{_p}, undef, q|$x->{_p} = undef|);
+is($y->{_a}, undef, q|$y->{_a} = undef|);
+is($y->{_p}, undef, q|$y->{_p} = undef|);
###############################################################################
# math with two numbers with different A and P
-$x = $mbf->new(12345); $x->accuracy(4); # '12340'
-$y = $mbf->new(12345); $y->accuracy(2); # '12000'
-is ($x+$y,24000); # 12340+12000=> 24340 => 24000
+$x = $mbf->new(12345);
+$x->accuracy(4); # "12340"
+$y = $mbf->new(12345);
+$y->accuracy(2); # "12000"
+is($x+$y, 24000, q|$x+$y = 24000|); # 12340+12000=> 24340 => 24000
-$x = $mbf->new(54321); $x->accuracy(4); # '12340'
-$y = $mbf->new(12345); $y->accuracy(3); # '12000'
-is ($x-$y,42000); # 54320+12300=> 42020 => 42000
+$x = $mbf->new(54321);
+$x->accuracy(4); # "12340"
+$y = $mbf->new(12345);
+$y->accuracy(3); # "12000"
+is($x-$y, 42000, q|$x-$y = 42000|); # 54320+12300=> 42020 => 42000
-$x = $mbf->new('1.2345'); $x->precision(-2); # '1.23'
-$y = $mbf->new('1.2345'); $y->precision(-4); # '1.2345'
-is ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46
+$x = $mbf->new("1.2345");
+$x->precision(-2); # "1.23"
+$y = $mbf->new("1.2345");
+$y->precision(-4); # "1.2345"
+is($x+$y, "2.46", q|$x+$y = "2.46"|); # 1.2345+1.2300=> 2.4645 => 2.46
###############################################################################
# round should find and use proper class
#$x = Foo->new();
-#is ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
-#is ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
-#is ($x->bfround($Foo::precision),'p' x $Foo::precision);
-#is ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
+#is($x->round($Foo::accuracy), "a" x $Foo::accuracy);
+#is($x->round(undef, $Foo::precision), "p" x $Foo::precision);
+#is($x->bfround($Foo::precision), "p" x $Foo::precision);
+#is($x->bround($Foo::accuracy), "a" x $Foo::accuracy);
###############################################################################
# find out whether _find_round_parameters is doing what's it's supposed to do
{
- no strict 'refs';
- ${"$mbi\::accuracy"} = undef;
- ${"$mbi\::precision"} = undef;
- ${"$mbi\::div_scale"} = 40;
- ${"$mbi\::round_mode"} = 'odd';
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = undef;
+ ${"$mbi\::div_scale"} = 40;
+ ${"$mbi\::round_mode"} = 'odd';
}
$x = $mbi->new(123);
my @params = $x->_find_round_parameters();
-is (scalar @params,1); # nothing to round
+is(scalar(@params), 1, q|scalar(@params) = 1|); # nothing to round
@params = $x->_find_round_parameters(1);
-is (scalar @params,4); # a=1
-is ($params[0],$x); # self
-is ($params[1],1); # a
-is ($params[2], undef); # p
-is ($params[3],'odd'); # round_mode
-
-@params = $x->_find_round_parameters(undef,2);
-is (scalar @params,4); # p=2
-is ($params[0],$x); # self
-is ($params[1], undef); # a
-is ($params[2],2); # p
-is ($params[3],'odd'); # round_mode
-
-eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
-like ($@, qr/^Unknown round mode 'foo'/);
-
-@params = $x->_find_round_parameters(undef,2,'+inf');
-is (scalar @params,4); # p=2
-is ($params[0],$x); # self
-is ($params[1], undef); # a
-is ($params[2],2); # p
-is ($params[3],'+inf'); # round_mode
-
-@params = $x->_find_round_parameters(2,-2,'+inf');
-is (scalar @params,1); # error, A and P defined
-is ($params[0],$x); # self
+is(scalar(@params), 4, q|scalar(@params) = 4|); # a=1
+is($params[0], $x, q|$params[0] = $x|); # self
+is($params[1], 1, q|$params[1] = 1|); # a
+is($params[2], undef, q|$params[2] = undef|); # p
+is($params[3], "odd", q|$params[3] = "odd"|); # round_mode
+
+@params = $x->_find_round_parameters(undef, 2);
+is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2
+is($params[0], $x, q|$params[0] = $x|); # self
+is($params[1], undef, q|$params[1] = undef|); # a
+is($params[2], 2, q|$params[2] = 2|); # p
+is($params[3], "odd", q|$params[3] = "odd"|); # round_mode
+
+eval { @params = $x->_find_round_parameters(undef, 2, "foo"); };
+like($@, qr/^Unknown round mode 'foo'/,
+ q|round mode "foo" gives a warning as expected|);
+
+@params = $x->_find_round_parameters(undef, 2, "+inf");
+is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2
+is($params[0], $x, q|$params[0] = $x|); # self
+is($params[1], undef, q|$params[1] = undef|); # a
+is($params[2], 2, q|$params[2] = 2|); # p
+is($params[3], "+inf", q|$params[3] = "+inf"|); # round_mode
+
+@params = $x->_find_round_parameters(2, -2, "+inf");
+is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined
+is($params[0], $x, q|$params[0] = $x|); # self
{
- no strict 'refs';
- ${"$mbi\::accuracy"} = 1;
- @params = $x->_find_round_parameters(undef,-2);
- is (scalar @params,1); # error, A and P defined
- is ($params[0],$x); # self
- is ($x->is_nan(),1); # and must be NaN
-
- ${"$mbi\::accuracy"} = undef;
- ${"$mbi\::precision"} = 1;
- @params = $x->_find_round_parameters(1,undef);
- is (scalar @params,1); # error, A and P defined
- is ($params[0],$x); # self
- is ($x->is_nan(),1); # and must be NaN
-
- ${"$mbi\::precision"} = undef; # reset
+ no strict 'refs';
+ ${"$mbi\::accuracy"} = 1;
+ @params = $x->_find_round_parameters(undef, -2);
+ is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined
+ is($params[0], $x, q|$params[0] = $x|); # self
+ is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN
+
+ ${"$mbi\::accuracy"} = undef;
+ ${"$mbi\::precision"} = 1;
+ @params = $x->_find_round_parameters(1, undef);
+ is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined
+ is($params[0], $x, q|$params[0] = $x|); # self
+ is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN
+
+ ${"$mbi\::precision"} = undef; # reset
}
###############################################################################
# test whether bone/bzero take additional A & P, or reset it etc
-foreach my $c ($mbi,$mbf)
- {
- $x = $c->new(2)->bzero(); is ($x->{_a}, undef); is ($x->{_p}, undef);
- $x = $c->new(2)->bone(); is ($x->{_a}, undef); is ($x->{_p}, undef);
- $x = $c->new(2)->binf(); is ($x->{_a}, undef); is ($x->{_p}, undef);
- $x = $c->new(2)->bnan(); is ($x->{_a}, undef); is ($x->{_p}, undef);
-
- $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
- is ($x->{_a}, undef); is ($x->{_p}, undef);
- $x = $c->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
- is ($x->{_a}, undef); is ($x->{_p}, undef);
-
- $x = $c->new(2,1); is ($x->{_a},1); is ($x->{_p}, undef);
- $x = $c->new(2,undef,1); is ($x->{_a}, undef); is ($x->{_p},1);
-
- $x = $c->new(2,1)->bzero(); is ($x->{_a},1); is ($x->{_p}, undef);
- $x = $c->new(2,undef,1)->bzero(); is ($x->{_a}, undef); is ($x->{_p},1);
-
- $x = $c->new(2,1)->bone(); is ($x->{_a},1); is ($x->{_p}, undef);
- $x = $c->new(2,undef,1)->bone(); is ($x->{_a}, undef); is ($x->{_p},1);
-
- $x = $c->new(2); $x->bone('+',2,undef); is ($x->{_a},2); is ($x->{_p}, undef);
- $x = $c->new(2); $x->bone('+',undef,2); is ($x->{_a}, undef); is ($x->{_p},2);
- $x = $c->new(2); $x->bone('-',2,undef); is ($x->{_a},2); is ($x->{_p}, undef);
- $x = $c->new(2); $x->bone('-',undef,2); is ($x->{_a}, undef); is ($x->{_p},2);
-
- $x = $c->new(2); $x->bzero(2,undef); is ($x->{_a},2); is ($x->{_p}, undef);
- $x = $c->new(2); $x->bzero(undef,2); is ($x->{_a}, undef); is ($x->{_p},2);
- }
+foreach my $class ($mbi, $mbf) {
+ $x = $class->new(2)->bzero();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2)->bone();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2)->binf();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2)->bnan();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2);
+ $x->{_a} = 1;
+ $x->{_p} = 2;
+ $x->bnan();
+
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2);
+ $x->{_a} = 1;
+ $x->{_p} = 2;
+ $x->binf();
+
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2, 1);
+ is($x->{_a}, 1, q|$x->{_a} = 1|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2, undef, 1);
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 1, q|$x->{_p} = 1|);
+
+ $x = $class->new(2, 1)->bzero();
+ is($x->{_a}, 1, q|$x->{_a} = 1|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2, undef, 1)->bzero();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 1, q|$x->{_p} = 1|);
+
+ $x = $class->new(2, 1)->bone();
+ is($x->{_a}, 1, q|$x->{_a} = 1|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2, undef, 1)->bone();
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 1, q|$x->{_p} = 1|);
+
+ $x = $class->new(2);
+ $x->bone('+', 2, undef);
+ is($x->{_a}, 2, q|$x->{_a} = 2|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2);
+ $x->bone('+', undef, 2);
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 2, q|$x->{_p} = 2|);
+
+ $x = $class->new(2);
+ $x->bone('-', 2, undef);
+ is($x->{_a}, 2, q|$x->{_a} = 2|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2);
+ $x->bone('-', undef, 2);
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 2, q|$x->{_p} = 2|);
+
+ $x = $class->new(2);
+ $x->bzero(2, undef);
+ is($x->{_a}, 2, q|$x->{_a} = 2|);
+ is($x->{_p}, undef, q|$x->{_p} = undef|);
+
+ $x = $class->new(2);
+ $x->bzero(undef, 2);
+ is($x->{_a}, undef, q|$x->{_a} = undef|);
+ is($x->{_p}, 2, q|$x->{_p} = 2|);
+}
###############################################################################
# test whether bone/bzero honour globals
-for my $c ($mbi,$mbf)
- {
- $c->accuracy(2);
- $x = $c->bone(); is ($x->accuracy(),2);
- $x = $c->bzero(); is ($x->accuracy(),2);
- $c->accuracy(undef);
-
- $c->precision(-2);
- $x = $c->bone(); is ($x->precision(),-2);
- $x = $c->bzero(); is ($x->precision(),-2);
- $c->precision(undef);
- }
+for my $class ($mbi, $mbf) {
+
+ $class->accuracy(2);
+ $x = $class->bone();
+ is($x->accuracy(), 2, q|$x->accuracy() = 2|);
+
+ $x = $class->bzero();
+ is($x->accuracy(), 2, q|$x->accuracy() = 2|);
+
+ $class->accuracy(undef); # reset
+
+ $class->precision(-2);
+ $x = $class->bone();
+ is($x->precision(), -2, q|$x->precision() = -2|);
+
+ $x = $class->bzero();
+ is($x->precision(), -2, q|$x->precision() = -2|);
+
+ $class->precision(undef); # reset
+}
###############################################################################
# check whether mixing A and P creates a NaN
# new with set accuracy/precision and with parameters
{
- no strict 'refs';
- foreach my $c ($mbi,$mbf)
- {
- is ($c->new(123,4,-3),'NaN'); # with parameters
- ${"$c\::accuracy"} = 42;
- ${"$c\::precision"} = 2;
- is ($c->new(123),'NaN'); # with globals
- ${"$c\::accuracy"} = undef;
- ${"$c\::precision"} = undef;
+ no strict 'refs';
+ foreach my $class ($mbi, $mbf) {
+ is($class->new(123, 4, -3), 'NaN', # with parameters
+ "mixing A and P creates a NaN");
+ ${"$class\::accuracy"} = 42;
+ ${"$class\::precision"} = 2;
+ is($class->new(123), "NaN", # with globals
+ q|$class->new(123) = "NaN"|);
+ ${"$class\::accuracy"} = undef;
+ ${"$class\::precision"} = undef;
}
}
# binary ops
-foreach my $class ($mbi,$mbf)
- {
- foreach (qw/add sub mul pow mod/)
- #foreach (qw/add sub mul div pow mod/)
- {
- my $try = "my \$x = $class->new(1234); \$x->accuracy(5); ";
- $try .= "my \$y = $class->new(12); \$y->precision(-3); ";
- $try .= "\$x->b$_(\$y);";
- $rc = eval $try;
- print "# Tried: '$try'\n" if !is ($rc, 'NaN');
+foreach my $class ($mbi, $mbf) {
+ #foreach (qw/add sub mul div pow mod/) {
+ foreach my $method (qw/add sub mul pow mod/) {
+ my $try = "my \$x = $class->new(1234); \$x->accuracy(5);";
+ $try .= " my \$y = $class->new(12); \$y->precision(-3);";
+ $try .= " \$x->b$method(\$y);";
+ $rc = eval $try;
+ is($rc, "NaN", $try);
}
- }
+}
# unary ops
-foreach (qw/new bsqrt/)
- {
- my $try = 'my $x = $mbi->$_(1234,5,-3); ';
- $rc = eval $try;
- print "# Tried: '$try'\n" if !is ($rc, 'NaN');
- }
+foreach my $method (qw/new bsqrt/) {
+ my $try = "my \$x = $mbi->$method(1234, 5, -3);";
+ $rc = eval $try;
+ is($rc, "NaN", $try);
+}
# see if $x->bsub(0) and $x->badd(0) really round
-foreach my $class ($mbi,$mbf)
- {
- $x = $class->new(123); $class->accuracy(2); $x->bsub(0);
- is ($x,120);
- $class->accuracy(undef);
- $x = $class->new(123); $class->accuracy(2); $x->badd(0);
- is ($x,120);
- $class->accuracy(undef);
- }
+foreach my $class ($mbi, $mbf) {
+ $x = $class->new(123);
+ $class->accuracy(2);
+ $x->bsub(0);
+ is($x, 120, q|$x = 120|);
+
+ $class->accuracy(undef); # reset
+
+ $x = $class->new(123);
+ $class->accuracy(2);
+ $x->badd(0);
+ is($x, 120, q|$x = 120|);
+
+ $class->accuracy(undef); # reset
+}
###############################################################################
# test whether shortcuts returning zero/one preserve A and P
-my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args);
+my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args);
+
my $CALC = Math::BigInt->config()->{lib};
-while (<DATA>)
- {
- $_ =~ s/[\n\r]//g; # remove newlines
- next if /^\s*(#|$)/; # skip comments and empty lines
- if (s/^&//)
- {
- $f = $_; next; # function
+
+while (<DATA>) {
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
+
+ if (s/^&//) {
+ $f = $_; # function
+ next;
}
- @args = split(/:/,$_,99);
- my $ans = pop(@args);
-
- ($x,$xa,$xp) = split (/,/,$args[0]);
- $xa = $xa || ''; $xp = $xp || '';
- $try = "\$x = $mbi->new('$x'); ";
- $try .= "\$x->accuracy($xa); " if $xa ne '';
- $try .= "\$x->precision($xp); " if $xp ne '';
-
- ($y,$ya,$yp) = split (/,/,$args[1]);
- $ya = $ya || ''; $yp = $yp || '';
- $try .= "\$y = $mbi->new('$y'); ";
- $try .= "\$y->accuracy($ya); " if $ya ne '';
- $try .= "\$y->precision($yp); " if $yp ne '';
-
- $try .= "\$x->$f(\$y);";
-
- # print "trying $try\n";
- $rc = eval $try;
- # convert hex/binary targets to decimal
- if ($ans =~ /^(0x0x|0b0b)/)
- {
- $ans =~ s/^0[xb]//;
- $ans = $mbi->new($ans)->bstr();
+
+ @args = split(/:/, $_);
+ my $want = pop(@args);
+
+ ($x, $xa, $xp) = split (/,/, $args[0]);
+ $xa = $xa || '';
+ $xp = $xp || '';
+ $try = qq|\$x = $mbi->new("$x");|;
+ $try .= qq| \$x->accuracy($xa);| if $xa ne '';
+ $try .= qq| \$x->precision($xp);| if $xp ne '';
+
+ ($y, $ya, $yp) = split (/,/, $args[1]);
+ $ya = $ya || '';
+ $yp = $yp || '';
+ $try .= qq| \$y = $mbi->new("$y");|;
+ $try .= qq| \$y->accuracy($ya);| if $ya ne '';
+ $try .= qq| \$y->precision($yp);| if $yp ne '';
+
+ $try .= ' $x->$f($y);';
+
+ # print "trying $try\n";
+ $rc = eval $try;
+ print "# Error: $@\n" if $@;
+
+ # convert hex/binary targets to decimal
+ if ($want =~ /^(0x0x|0b0b)/) {
+ $want =~ s/^0[xb]//;
+ $want = $mbi->new($want)->bstr();
}
- print "# Tried: '$try'\n" if !is ($rc, $ans);
- # check internal state of number objects
- is_valid($rc,$f) if ref $rc;
-
- # now check whether A and P are set correctly
- # only one of $a or $p will be set (no crossing here)
- $a = $xa || $ya; $p = $xp || $yp;
-
- # print "Check a=$a p=$p\n";
- # print "# Tried: '$try'\n";
- if ($a ne '')
- {
- if (!(is ($x->{_a}, $a) && is ($x->{_p}, undef)))
- {
- print "# Check: A=$a and P=undef\n";
- print "# Tried: '$try'\n";
- }
+ is($rc, $want, $try);
+ # check internal state of number objects
+ is_valid($rc, $f) if ref $rc;
+
+ # now check whether A and P are set correctly
+ # only one of $a or $p will be set (no crossing here)
+ $a = $xa || $ya;
+ $p = $xp || $yp;
+
+ # print "Check a=$a p=$p\n";
+ # print "# Tried: '$try'\n";
+ if ($a ne '') {
+ unless (is($x->{_a}, $a, qq|\$x->{_a} == $a|) &&
+ is($x->{_p}, undef, qq|\$x->{_p} is undef|))
+ {
+ print "# Check: A = $a and P = undef\n";
+ print "# Tried: $try\n";
+ }
}
- if ($p ne '')
- {
- if (!(is ($x->{_p}, $p) && is($x->{_a}, undef)))
- {
- print "# Check: A=undef and P=$p\n";
- print "# Tried: '$try'\n";
- }
+ if ($p ne '') {
+ unless (is($x->{_p}, $p, qq|\$x->{_p} == $p|) &&
+ is($x->{_a}, undef, qq|\$x->{_a} is undef|))
+ {
+ print "# Check: A = undef and P = $p\n";
+ print "# Tried: $try\n";
+ }
}
- }
+}
# all done
1;
###############################################################################
-# sub to check validity of a BigInt internally, to ensure that no op leaves a
-# number object in an invalid state (f.i. "-0")
+# sub to check validity of a Math::BigInt object internally, to ensure that no
+# op leaves a number object in an invalid state (f.i. "-0")
-sub is_valid
- {
- my ($x,$f) = @_;
+sub is_valid {
+ my ($x, $f) = @_;
- my $e = 0; # error?
- # ok as reference?
- $e = 'Not a reference' if !ref($x);
+ my $e = 0; # error?
- # has ok sign?
- $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
- if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+ # ok as reference?
+ $e = 'Not a reference' if !ref($x);
- $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
- $e = $CALC->_check($x->{value}) if $e eq '0';
+ # has ok sign?
+ $e = qq|Illegal sign $x->{sign}|
+ . q| (expected: "+", "-", "-inf", "+inf" or "NaN")|
+ if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
- # test done, see if error did crop up
- is (1,1), return if ($e eq '0');
+ $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
+ $e = $CALC->_check($x->{value}) if $e eq '0';
- is (1,$e." after op '$f'");
- }
+ # test done, see if error did crop up
+ if ($e eq '0') {
+ pass('is a valid object');
+ return;
+ }
+
+ fail($e . qq| after op "$f"|);
+}
# format is:
# x,A,P:x,A,P:result
diff --git a/cpan/Math-BigInt/t/mbimbf.t b/cpan/Math-BigInt/t/mbimbf.t
index f3d34ece7e..afad66f423 100644
--- a/cpan/Math-BigInt/t/mbimbf.t
+++ b/cpan/Math-BigInt/t/mbimbf.t
@@ -1,78 +1,92 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# test rounding, accuracy, precision and fallback, round_mode and mixing
# of classes
use strict;
-use Test::More tests => 684
- + 26; # own tests
+use warnings;
+
+use Test::More tests => 684 # tests in require'd file
+ + 26; # tests in this file
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
-use vars qw/$mbi $mbf/;
-
-$mbi = 'Math::BigInt';
-$mbf = 'Math::BigFloat';
+our $mbi = 'Math::BigInt';
+our $mbf = 'Math::BigFloat';
require 't/mbimbf.inc';
# some tests that won't work with subclasses, since the things are only
-# guaranteed in the Math::BigInt/BigFloat (unless subclass chooses to support
+# guaranteed in the Math::Big(Int|Float) (unless subclass chooses to support
# this)
-Math::BigInt->round_mode('even'); # reset for tests
-Math::BigFloat->round_mode('even'); # reset for tests
+Math::BigInt->round_mode("even"); # reset for tests
+Math::BigFloat->round_mode("even"); # reset for tests
-is ($Math::BigInt::rnd_mode,'even');
-is ($Math::BigFloat::rnd_mode,'even');
+is($Math::BigInt::rnd_mode, "even", '$Math::BigInt::rnd_mode = "even"');
+is($Math::BigFloat::rnd_mode, "even", '$Math::BigFloat::rnd_mode = "even"');
my $x = eval '$mbi->round_mode("huhmbi");';
-like ($@, qr/^Unknown round mode 'huhmbi' at/);
+like($@, qr/^Unknown round mode 'huhmbi' at/,
+ '$mbi->round_mode("huhmbi")');
$x = eval '$mbf->round_mode("huhmbf");';
-like ($@, qr/^Unknown round mode 'huhmbf' at/);
+like($@, qr/^Unknown round mode 'huhmbf' at/,
+ '$mbf->round_mode("huhmbf")');
# old way (now with test for validity)
$x = eval '$Math::BigInt::rnd_mode = "huhmbi";';
-like ($@, qr/^Unknown round mode 'huhmbi' at/);
+like($@, qr/^Unknown round mode 'huhmbi' at/,
+ '$Math::BigInt::rnd_mode = "huhmbi"');
$x = eval '$Math::BigFloat::rnd_mode = "huhmbf";';
-like ($@, qr/^Unknown round mode 'huhmbf' at/);
+like($@, qr/^Unknown round mode 'huhmbf' at/,
+ '$Math::BigFloat::rnd_mode = "huhmbf"');
+
# see if accessor also changes old variable
-$mbi->round_mode('odd'); is ($Math::BigInt::rnd_mode,'odd');
-$mbf->round_mode('odd'); is ($Math::BigInt::rnd_mode,'odd');
-
-foreach my $class (qw/Math::BigInt Math::BigFloat/)
- {
- is ($class->accuracy(5),5); # set A
- is ($class->precision(), undef); # and now P must be cleared
- is ($class->precision(5),5); # set P
- is ($class->accuracy(), undef); # and now A must be cleared
- }
-
-foreach my $class (qw/Math::BigInt Math::BigFloat/)
- {
- $class->accuracy(42);
- my $x = $class->new(123); # $x gets A of 42, too!
- is ($x->accuracy(),42); # really?
- is ($x->accuracy(undef),42); # $x has no A, but the
- # global is still in effect for $x
- # so the return value of that operation should
- # be 42, not undef
- is ($x->accuracy(),42); # so $x should still have A = 42
- $class->accuracy(undef); # reset for further tests
- $class->precision(undef);
- }
-# bug with blog(Math::BigFloat,Math::BigInt)
+$mbi->round_mode('odd');
+is($Math::BigInt::rnd_mode, 'odd', '$Math::BigInt::rnd_mode = "odd"');
+
+$mbf->round_mode('odd');
+is($Math::BigInt::rnd_mode, 'odd', '$Math::BigInt::rnd_mode = "odd"');
+
+foreach my $class (qw/Math::BigInt Math::BigFloat/) {
+ is($class->accuracy(5), 5, "set A ...");
+ is($class->precision(), undef, "... and now P must be cleared");
+ is($class->precision(5), 5, "set P ...");
+ is($class->accuracy(), undef, "... and now A must be cleared");
+}
+
+foreach my $class (qw/Math::BigInt Math::BigFloat/) {
+ $class->accuracy(42);
+
+ # $x gets A of 42, too!
+ my $x = $class->new(123);
+
+ # really?
+ is($x->accuracy(), 42, '$x has A of 42');
+
+ # $x has no A, but the global is still in effect for $x so the return value
+ # of that operation should be 42, not undef
+ is($x->accuracy(undef), 42, '$x has A from global');
+
+ # so $x should still have A = 42
+ is($x->accuracy(), 42, '$x has still A of 42');
+
+ # reset for further tests
+ $class->accuracy(undef);
+ $class->precision(undef);
+}
+
+# bug with blog(Math::BigFloat, Math::BigInt)
$x = Math::BigFloat->new(100);
$x = $x->blog(Math::BigInt->new(10));
-is ($x,2);
+is($x, 2, 'bug with blog(Math::BigFloat, Math::BigInt)');
# bug until v1.88 for sqrt() with enough digits
-for my $i (80,88,100)
- {
- $x = Math::BigFloat->new("1." . ("0" x $i) . "1");
- $x = $x->bsqrt;
- is ($x, 1);
- }
+for my $i (80, 88, 100) {
+ $x = Math::BigFloat->new("1." . ("0" x $i) . "1");
+ $x = $x->bsqrt;
+ is($x, 1, '$x->bsqrt() with many digits');
+}
diff --git a/cpan/Math-BigInt/t/nan_cmp.t b/cpan/Math-BigInt/t/nan_cmp.t
index 983edcbddc..c84be9003e 100644
--- a/cpan/Math-BigInt/t/nan_cmp.t
+++ b/cpan/Math-BigInt/t/nan_cmp.t
@@ -1,36 +1,39 @@
-#!/usr/bin/perl -w
+#!perl
# test that overloaded compare works when NaN are involved
use strict;
+use warnings;
+
use Test::More tests => 26;
use Math::BigInt;
use Math::BigFloat;
-compare (Math::BigInt->bnan(), Math::BigInt->bone() );
-compare (Math::BigFloat->bnan(), Math::BigFloat->bone() );
+compare('Math::BigInt');
+compare('Math::BigFloat');
-sub compare
- {
- my ($nan, $one) = @_;
+sub compare {
+ my $class = shift;
- is ($one, $one, '1 == 1');
+ my $nan = $class->bnan();
+ my $one = $class->bone();
- is ($one != $nan, 1, "1 != NaN");
- is ($nan != $one, 1, "NaN != 1");
- is ($nan != $nan, 1, "NaN != NaN");
+ is($one, $one, "$class->bone() == $class->bone()");
- is ($nan == $one, '', "NaN == 1");
- is ($one == $nan, '', "1 == NaN");
- is ($nan == $nan, '', "NaN == NaN");
+ is($one != $nan, 1, "$class->bone() != $class->bnan()");
+ is($nan != $one, 1, "$class->bnan() != $class->bone()");
+ is($nan != $nan, 1, "$class->bnan() != $class->bnan()");
- is ($nan <= $one, '', "NaN <= 1");
- is ($one <= $nan, '', "1 <= NaN");
- is ($nan <= $nan, '', "NaN <= NaN");
+ is($nan == $one, '', "$class->bnan() == $class->bone()");
+ is($one == $nan, '', "$class->bone() == $class->bnan()");
+ is($nan == $nan, '', "$class->bnan() == $class->bnan()");
- is ($nan >= $one, '', "NaN >= 1");
- is ($one >= $nan, '', "1 >= NaN");
- is ($nan >= $nan, '', "NaN >= NaN");
- }
+ is($nan <= $one, '', "$class->bnan() <= $class->bone()");
+ is($one <= $nan, '', "$class->bone() <= $class->bnan()");
+ is($nan <= $nan, '', "$class->bnan() <= $class->bnan()");
+ is($nan >= $one, '', "$class->bnan() >= $class->bone()");
+ is($one >= $nan, '', "$class->bone() >= $class->bnan()");
+ is($nan >= $nan, '', "$class->bnan() >= $class->bnan()");
+}
diff --git a/cpan/Math-BigInt/t/new_overloaded.t b/cpan/Math-BigInt/t/new_overloaded.t
index 08708dc557..011f54fc78 100644
--- a/cpan/Math-BigInt/t/new_overloaded.t
+++ b/cpan/Math-BigInt/t/new_overloaded.t
@@ -1,32 +1,38 @@
-#!/usr/bin/perl -w
+#!perl
# Math::BigFloat->new had a bug where it would assume any object is a
-# BigInt which broke overloaded non-BigInts.
+# Math::BigInt which broke overloaded non-Math::BigInt objects.
+
+use strict;
+use warnings;
use Test::More tests => 4;
+##############################################################################
package Overloaded::Num;
-use overload '0+' => sub { ${$_[0]} },
- fallback => 1;
+use overload
+ '0+' => sub { ${$_[0]} },
+ fallback => 1;
+
sub new {
- my($class, $num) = @_;
+ my ($class, $num) = @_;
return bless \$num, $class;
}
-
package main;
use Math::BigFloat;
my $overloaded_num = Overloaded::Num->new(2.23);
-is $overloaded_num, 2.23;
+is($overloaded_num, 2.23, 'Overloaded::Num->new(2.23)');
my $bigfloat = Math::BigFloat->new($overloaded_num);
-is $bigfloat, 2.23, 'BigFloat->new accepts overloaded numbers';
+is($bigfloat, 2.23, 'Math::BigFloat->new() accepts overloaded numbers');
my $bigint = Math::BigInt->new(Overloaded::Num->new(3));
-is $bigint, 3, 'BigInt->new accepts overloaded numbers';
+is($bigint, 3, 'Math::BigInt->new() accepts overloaded numbers');
-is( Math::BigFloat->new($bigint), 3, 'BigFloat from BigInt' );
+is(Math::BigFloat->new($bigint), 3,
+ 'Math::BigFloat->new() accepts a Math::BigInt');
diff --git a/cpan/Math-BigInt/t/objectify_mbf.t b/cpan/Math-BigInt/t/objectify_mbf.t
index a91ad4b3c7..258ed7b196 100644
--- a/cpan/Math-BigInt/t/objectify_mbf.t
+++ b/cpan/Math-BigInt/t/objectify_mbf.t
@@ -24,13 +24,22 @@ for my $class ('Math::BigFloat', 'Math::BigFloat::Subclass') {
# objectify() has done its thing.
my $float_percent1 = My::Percent::Float1 -> new(100);
- is($float * $float_percent1, 10);
+ is($float * $float_percent1, 10,
+ qq|\$float = $class -> new(10);|
+ . q| $float_percent1 = My::Percent::Float1 -> new(100);|
+ . q| $float * $float_percent1;|);
my $float_percent2 = My::Percent::Float2 -> new(100);
- is($float * $float_percent2, 10);
+ is($float * $float_percent2, 10,
+ qq|\$float = $class -> new(10);|
+ . q| $float_percent2 = My::Percent::Float2 -> new(100);|
+ . q| $float * $float_percent2;|);
my $float_percent3 = My::Percent::Float3 -> new(100);
- is($float * $float_percent3, 10);
+ is($float * $float_percent3, 10,
+ qq|\$float = $class -> new(10);|
+ . q| $float_percent3 = My::Percent::Float3 -> new(100);|
+ . q| $float * $float_percent3;|);
}
###############################################################################
diff --git a/cpan/Math-BigInt/t/objectify_mbi.t b/cpan/Math-BigInt/t/objectify_mbi.t
index 155dd52f3e..8bb3571969 100644
--- a/cpan/Math-BigInt/t/objectify_mbi.t
+++ b/cpan/Math-BigInt/t/objectify_mbi.t
@@ -24,19 +24,34 @@ for my $class ('Math::BigInt', 'Math::BigInt::Subclass') {
# objectify() has done its thing.
my $int_percent1 = My::Percent::Int1 -> new(100);
- is($int * $int_percent1, 10);
+ is($int * $int_percent1, 10,
+ qq|\$class -> new(10);|
+ . q| $int_percent1 = My::Percent::Int1 -> new(100);|
+ . q| $int * $int_percent1|);
my $int_percent2 = My::Percent::Int2 -> new(100);
- is($int * $int_percent2, 10);
+ is($int * $int_percent2, 10,
+ qq|\$class -> new(10);|
+ . q| $int_percent2 = My::Percent::Int2 -> new(100);|
+ . q| $int * $int_percent2|);
my $int_percent3 = My::Percent::Int3 -> new(100);
- is($int * $int_percent3, 10);
+ is($int * $int_percent3, 10,
+ qq|\$class -> new(10);|
+ . q| $int_percent3 = My::Percent::Int3 -> new(100);|
+ . q| $int * $int_percent3|);
my $int_percent4 = My::Percent::Int4 -> new(100);
- is($int * $int_percent4, 10);
+ is($int * $int_percent4, 10,
+ qq|\$class -> new(10);|
+ . q| $int_percent4 = My::Percent::Int4 -> new(100);|
+ . q| $int * $int_percent4|);
my $int_percent5 = My::Percent::Int5 -> new(100);
- is($int * $int_percent5, 10);
+ is($int * $int_percent5, 10,
+ qq|\$class -> new(10);|
+ . q| $int_percent5 = My::Percent::Int5 -> new(100);|
+ . q| $int * $int_percent5|);
}
###############################################################################
diff --git a/cpan/Math-BigInt/t/req_mbf0.t b/cpan/Math-BigInt/t/req_mbf0.t
index 4df4d4a24b..f8af78727f 100644
--- a/cpan/Math-BigInt/t/req_mbf0.t
+++ b/cpan/Math-BigInt/t/req_mbf0.t
@@ -1,13 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
-# check that simple requiring BigFloat and then bzero() works
+# check that simple requiring Math::BigFloat and then bzero() works
use strict;
+use warnings;
+
use Test::More tests => 1;
require Math::BigFloat;
+
my $x = Math::BigFloat->bzero(); $x++;
-is ($x,1, '$x is 1');
+is($x, 1, '$x is 1');
# all tests done
-
diff --git a/cpan/Math-BigInt/t/req_mbf1.t b/cpan/Math-BigInt/t/req_mbf1.t
index ac8375c309..f9b7cc48e2 100644
--- a/cpan/Math-BigInt/t/req_mbf1.t
+++ b/cpan/Math-BigInt/t/req_mbf1.t
@@ -1,10 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
-# check that simple requiring BigFloat and then bone() works
+# check that simple requiring Math::BigFloat and then bone() works
use strict;
+use warnings;
+
use Test::More tests => 1;
-require Math::BigFloat; my $x = Math::BigFloat->bone(); is ($x,1);
+require Math::BigFloat;
+
+my $x = Math::BigFloat->bone();
+is($x, 1, '$x is 1');
# all tests done
diff --git a/cpan/Math-BigInt/t/req_mbfa.t b/cpan/Math-BigInt/t/req_mbfa.t
index eb4d5e10cb..1a83b1cca6 100644
--- a/cpan/Math-BigInt/t/req_mbfa.t
+++ b/cpan/Math-BigInt/t/req_mbfa.t
@@ -1,10 +1,15 @@
-#!/usr/bin/perl -w
+#!perl
-# check that simple requiring BigFloat and then bnan() works
+# check that simple requiring Math::BigFloat and then bnan() works
use strict;
+use warnings;
+
use Test::More tests => 1;
-require Math::BigFloat; my $x = Math::BigFloat->bnan(1); is ($x,'NaN');
+require Math::BigFloat;
+
+my $x = Math::BigFloat->bnan(1);
+is($x, 'NaN', '$x is NaN');
# all tests done
diff --git a/cpan/Math-BigInt/t/req_mbfi.t b/cpan/Math-BigInt/t/req_mbfi.t
index 1ea5224c23..9db1e9ab84 100644
--- a/cpan/Math-BigInt/t/req_mbfi.t
+++ b/cpan/Math-BigInt/t/req_mbfi.t
@@ -1,10 +1,15 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# check that simple requiring BigFloat and then binf() works
+# check that simple requiring Math::BigFloat and then binf() works
use strict;
+use warnings;
+
use Test::More tests => 1;
-require Math::BigFloat; my $x = Math::BigFloat->binf(); is ($x,'inf');
+require Math::BigFloat;
+
+my $x = Math::BigFloat->binf();
+is($x, 'inf', '$x is inf');
# all tests done
diff --git a/cpan/Math-BigInt/t/req_mbfn.t b/cpan/Math-BigInt/t/req_mbfn.t
index 1db441798a..ffeb8b3b0e 100644
--- a/cpan/Math-BigInt/t/req_mbfn.t
+++ b/cpan/Math-BigInt/t/req_mbfn.t
@@ -1,10 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# check that simple requiring BigFloat and then new() works
+# check that simple requiring Math::BigFloat and then new() works
use strict;
+use warnings;
+
use Test::More tests => 1;
-require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; is ($x,2);
+require Math::BigFloat;
+
+my $x = Math::BigFloat->new(1);
+++$x;
+is($x, 2, '$x is 2');
# all tests done
diff --git a/cpan/Math-BigInt/t/req_mbfw.t b/cpan/Math-BigInt/t/req_mbfw.t
index 9b075c0a74..6a8429a90e 100644
--- a/cpan/Math-BigInt/t/req_mbfw.t
+++ b/cpan/Math-BigInt/t/req_mbfw.t
@@ -1,23 +1,29 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# check that requiring BigFloat and then calling import() works
+# check that requiring Math::BigFloat and then calling import() works
use strict;
+use warnings;
+
use Test::More tests => 3;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
# normal require that calls import automatically (we thus have MBI afterwards)
require Math::BigFloat;
-my $x = Math::BigFloat->new(1); ++$x;
-is ($x,2, '$x is 2');
-like (Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, 'with ignored' );
+my $x = Math::BigFloat->new(1);
+++$x;
+is($x, 2, '$x is 2');
+
+like(Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/,
+ '"with" ignored');
# now override
-Math::BigFloat->import ( with => 'Math::BigInt::Subclass' );
+Math::BigFloat->import(with => 'Math::BigInt::Subclass');
# the "with" argument is ignored
-like (Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, 'with ignored' );
+like(Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/,
+ '"with" ignored');
# all tests done
diff --git a/cpan/Math-BigInt/t/require.t b/cpan/Math-BigInt/t/require.t
index 66d9687a13..3c34db6885 100644
--- a/cpan/Math-BigInt/t/require.t
+++ b/cpan/Math-BigInt/t/require.t
@@ -1,15 +1,17 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# check that simple requiring BigInt works
+# check that simple requiring Math::BigInt works
use strict;
+use warnings;
+
use Test::More tests => 1;
-my ($x);
+require Math::BigInt;
-require Math::BigInt; $x = Math::BigInt->new(1); ++$x;
+my $x = Math::BigInt->new(1);
+++$x;
-is ($x,2);
+is($x, 2, '$x is 2');
# all tests done
-
diff --git a/cpan/Math-BigInt/t/round.t b/cpan/Math-BigInt/t/round.t
index 078e2d055b..4110626c3d 100644
--- a/cpan/Math-BigInt/t/round.t
+++ b/cpan/Math-BigInt/t/round.t
@@ -1,16 +1,18 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# test rounding with non-integer A and P parameters
use strict;
+use warnings;
+
use Test::More tests => 95;
use Math::BigFloat;
-my $cf = 'Math::BigFloat';
-my $ci = 'Math::BigInt';
+my $mbf = 'Math::BigFloat';
+#my $mbi = 'Math::BigInt';
-my $x = $cf->new('123456.123456');
+my $x = $mbf->new('123456.123456');
# unary ops with A
_do_a($x, 'round', 3, '123000');
@@ -28,7 +30,7 @@ _do_a($x, 'bsqrt', 3, '351');
_do_a($x, 'bsqrt', 2, '350');
# setting P
-_do_p($x, 'bsqrt', 2, '350');
+_do_p($x, 'bsqrt', 2, '350');
_do_p($x, 'bsqrt', -2, '351.36');
# binary ops
@@ -44,51 +46,51 @@ _do_2_p($x, 'bdiv', 2, -3, '61728.062');
#############################################################################
-sub _do_a
- {
- my ($x, $method, $A, $result) = @_;
-
- is ($x->copy->$method($A), $result, "$method($A)");
- is ($x->copy->$method($A.'.1'), $result, "$method(${A}.1)");
- is ($x->copy->$method($A.'.5'), $result, "$method(${A}.5)");
- is ($x->copy->$method($A.'.6'), $result, "$method(${A}.6)");
- is ($x->copy->$method($A.'.9'), $result, "$method(${A}.9)");
- }
-
-sub _do_p
- {
- my ($x, $method, $P, $result) = @_;
-
- is ($x->copy->$method(undef,$P), $result, "$method(undef,$P)");
- is ($x->copy->$method(undef,$P.'.1'), $result, "$method(undef,${P}.1)");
- is ($x->copy->$method(undef,$P.'.5'), $result, "$method(undef.${P}.5)");
- is ($x->copy->$method(undef,$P.'.6'), $result, "$method(undef,${P}.6)");
- is ($x->copy->$method(undef,$P.'.9'), $result, "$method(undef,${P}.9)");
- }
-
-sub _do_2_a
- {
- my ($x, $method, $y, $A, $result) = @_;
-
- my $cy = $cf->new($y);
-
- is ($x->copy->$method($cy,$A), $result, "$method($cy,$A)");
- is ($x->copy->$method($cy,$A.'.1'), $result, "$method($cy,${A}.1)");
- is ($x->copy->$method($cy,$A.'.5'), $result, "$method($cy,${A}.5)");
- is ($x->copy->$method($cy,$A.'.6'), $result, "$method($cy,${A}.6)");
- is ($x->copy->$method($cy,$A.'.9'), $result, "$method($cy,${A}.9)");
- }
-
-sub _do_2_p
- {
- my ($x, $method, $y, $P, $result) = @_;
-
- my $cy = $cf->new($y);
-
- is ($x->copy->$method($cy,undef,$P), $result, "$method(undef,$P)");
- is ($x->copy->$method($cy,undef,$P.'.1'), $result, "$method($cy,undef,${P}.1)");
- is ($x->copy->$method($cy,undef,$P.'.5'), $result, "$method($cy,undef.${P}.5)");
- is ($x->copy->$method($cy,undef,$P.'.6'), $result, "$method($cy,undef,${P}.6)");
- is ($x->copy->$method($cy,undef,$P.'.9'), $result, "$method($cy,undef,${P}.9)");
- }
-
+sub _do_a {
+ my ($x, $method, $A, $result) = @_;
+
+ is($x->copy->$method($A), $result, "$method($A)");
+ is($x->copy->$method($A.'.1'), $result, "$method(${A}.1)");
+ is($x->copy->$method($A.'.5'), $result, "$method(${A}.5)");
+ is($x->copy->$method($A.'.6'), $result, "$method(${A}.6)");
+ is($x->copy->$method($A.'.9'), $result, "$method(${A}.9)");
+}
+
+sub _do_p {
+ my ($x, $method, $P, $result) = @_;
+
+ is($x->copy->$method(undef, $P), $result, "$method(undef, $P)");
+ is($x->copy->$method(undef, $P.'.1'), $result, "$method(undef, ${P}.1)");
+ is($x->copy->$method(undef, $P.'.5'), $result, "$method(undef.${P}.5)");
+ is($x->copy->$method(undef, $P.'.6'), $result, "$method(undef, ${P}.6)");
+ is($x->copy->$method(undef, $P.'.9'), $result, "$method(undef, ${P}.9)");
+}
+
+sub _do_2_a {
+ my ($x, $method, $y, $A, $result) = @_;
+
+ my $cy = $mbf->new($y);
+
+ is($x->copy->$method($cy, $A), $result, "$method($cy, $A)");
+ is($x->copy->$method($cy, $A.'.1'), $result, "$method($cy, ${A}.1)");
+ is($x->copy->$method($cy, $A.'.5'), $result, "$method($cy, ${A}.5)");
+ is($x->copy->$method($cy, $A.'.6'), $result, "$method($cy, ${A}.6)");
+ is($x->copy->$method($cy, $A.'.9'), $result, "$method($cy, ${A}.9)");
+}
+
+sub _do_2_p {
+ my ($x, $method, $y, $P, $result) = @_;
+
+ my $cy = $mbf->new($y);
+
+ is($x->copy->$method($cy, undef, $P), $result,
+ "$method(undef, $P)");
+ is($x->copy->$method($cy, undef, $P.'.1'), $result,
+ "$method($cy, undef, ${P}.1)");
+ is($x->copy->$method($cy, undef, $P.'.5'), $result,
+ "$method($cy, undef, ${P}.5)");
+ is($x->copy->$method($cy, undef, $P.'.6'), $result,
+ "$method($cy, undef, ${P}.6)");
+ is($x->copy->$method($cy, undef, $P.'.9'), $result,
+ "$method($cy, undef, ${P}.9)");
+}
diff --git a/cpan/Math-BigInt/t/rt-16221.t b/cpan/Math-BigInt/t/rt-16221.t
index a1dc2c6a3a..d531046085 100644
--- a/cpan/Math-BigInt/t/rt-16221.t
+++ b/cpan/Math-BigInt/t/rt-16221.t
@@ -22,14 +22,14 @@ use Math::BigFloat;
my $int = Math::BigInt->new(10);
my $int_percent = My::Percent::Float->new(100);
-is($int * $int_percent, 10);
+is($int * $int_percent, 10, '$int * $int_percent = 10');
############################################################################
my $float = Math::BigFloat->new(10);
my $float_percent = My::Percent::Float->new(100);
-is($float * $float_percent, 10);
+is($float * $float_percent, 10, '$float * $float_percent = 10');
############################################################################
diff --git a/cpan/Math-BigInt/t/sub_ali.t b/cpan/Math-BigInt/t/sub_ali.t
index 04512abd6c..6023be3624 100644
--- a/cpan/Math-BigInt/t/sub_ali.t
+++ b/cpan/Math-BigInt/t/sub_ali.t
@@ -1,15 +1,17 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# test that the new alias names work
use strict;
+use warnings;
+
use Test::More tests => 6;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigInt::Subclass;
-use vars qw/$CL $x/;
-$CL = 'Math::BigInt::Subclass';
+our $CLASS;
+$CLASS = 'Math::BigInt::Subclass';
require 't/alias.inc';
diff --git a/cpan/Math-BigInt/t/sub_mbf.t b/cpan/Math-BigInt/t/sub_mbf.t
index c7a028a8f9..9f6d58e3c9 100644
--- a/cpan/Math-BigInt/t/sub_mbf.t
+++ b/cpan/Math-BigInt/t/sub_mbf.t
@@ -1,33 +1,36 @@
-#!/usr/bin/perl -w
+#!perl
use strict;
-use Test::More tests => 2363
- + 6; # + our own tests
+use warnings;
+use Test::More tests => 2409 # tests in require'd file
+ + 6; # tests in this file
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigFloat::Subclass;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigFloat::Subclass";
-$CL = Math::BigFloat->config()->{lib}; # "Math::BigInt::Calc"; or FastCalc
+our ($CLASS, $CALC);
+$CLASS = "Math::BigFloat::Subclass";
+$CALC = Math::BigFloat->config()->{lib}; # backend
require 't/bigfltpm.inc'; # perform same tests as bigfltpm
###############################################################################
# Now do custom tests for Subclass itself
-my $ms = $class->new(23);
-print "# Missing custom attribute \$ms->{_custom}" if !is (1, $ms->{_custom});
+
+my $ms = $CLASS->new(23);
+is($ms->{_custom}, 1, '$ms has custom attribute \$ms->{_custom}');
# Check that subclass is a Math::BigFloat, but not a Math::Bigint
-isa_ok ($ms, 'Math::BigFloat');
-isnt ($ms->isa('Math::BigInt'), 1);
+isa_ok($ms, 'Math::BigFloat');
+ok(!$ms->isa('Math::BigInt'),
+ "An object of class '" . ref($ms) . "' isn't a 'Math::BigFloat'");
use Math::BigFloat;
-my $bf = Math::BigFloat->new(23); # same as other
+my $bf = Math::BigFloat->new(23); # same as other
$ms += $bf;
-print "# Tried: \$ms += \$bf, got $ms" if !is (46, $ms);
-print "# Missing custom attribute \$ms->{_custom}" if !is (1, $ms->{_custom});
-print "# Wrong class: ref(\$ms) was ".ref($ms) if !is ($class, ref($ms));
+is($ms, 46, '$ms is 46');
+is($ms->{_custom}, 1, '$ms has custom attribute $ms->{_custom}');
+is(ref($ms), $CLASS, "\$ms is not an object of class '$CLASS'");
diff --git a/cpan/Math-BigInt/t/sub_mbi.t b/cpan/Math-BigInt/t/sub_mbi.t
index 1af9f1cdc3..a0b9e5f066 100644
--- a/cpan/Math-BigInt/t/sub_mbi.t
+++ b/cpan/Math-BigInt/t/sub_mbi.t
@@ -1,34 +1,34 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
-use Test::More tests => 3701
- + 5; # +5 own tests
+use warnings;
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 3724 # tests in require'd file
+ + 5; # tests in this file
-use Math::BigInt::Subclass;
+use lib 't';
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigInt::Subclass";
-$CL = "Math::BigInt::Calc";
+use Math::BigInt::Subclass;
-my $version = '0.02'; # for $VERSION tests, match current release (by hand!)
+our ($CLASS, $CALC);
+$CLASS = "Math::BigInt::Subclass";
+$CALC = "Math::BigInt::Calc"; # backend
-require 't/bigintpm.inc'; # perform same tests as bigintpm
+require 't/bigintpm.inc'; # perform same tests as bigintpm
###############################################################################
# Now do custom tests for Subclass itself
-my $ms = $class->new(23);
-print "# Missing custom attribute \$ms->{_custom}" if !is (1, $ms->{_custom});
+my $ms = $CLASS->new(23);
+is($ms->{_custom}, 1, '$ms has custom attribute \$ms->{_custom}');
-# Check that a subclass is still considered a BigInt
-isa_ok ($ms, 'Math::BigInt');
+# Check that a subclass is still considered a Math::BigInt
+isa_ok($ms, 'Math::BigInt');
use Math::BigInt;
my $bi = Math::BigInt->new(23); # same as other
$ms += $bi;
-print "# Tried: \$ms += \$bi, got $ms" if !is (46, $ms);
-print "# Missing custom attribute \$ms->{_custom}" if !is (1, $ms->{_custom});
-print "# Wrong class: ref(\$ms) was ".ref($ms) if !is ($class, ref($ms));
+is($ms, 46, '$ms is 46');
+is($ms->{_custom}, 1, '$ms has custom attribute $ms->{_custom}');
+is(ref($ms), $CLASS, "\$ms is not an object of class '$CLASS'");
diff --git a/cpan/Math-BigInt/t/sub_mif.t b/cpan/Math-BigInt/t/sub_mif.t
index 6317e97cf3..464dfb50fb 100644
--- a/cpan/Math-BigInt/t/sub_mif.t
+++ b/cpan/Math-BigInt/t/sub_mif.t
@@ -1,18 +1,19 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# test rounding, accuracy, precision and fallback, round_mode and mixing
# of classes
use strict;
+use warnings;
+
use Test::More tests => 684;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;
-use vars qw/$mbi $mbf/;
-
+our ($mbi, $mbf);
$mbi = 'Math::BigInt::Subclass';
$mbf = 'Math::BigFloat::Subclass';
diff --git a/cpan/Math-BigInt/t/trap.t b/cpan/Math-BigInt/t/trap.t
index c3348b3d1f..5fdf4c24b2 100644
--- a/cpan/Math-BigInt/t/trap.t
+++ b/cpan/Math-BigInt/t/trap.t
@@ -1,84 +1,85 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# test that config ( trap_nan => 1, trap_inf => 1) really works/dies
-use Test::More tests => 43;
use strict;
+use warnings;
+
+use Test::More tests => 43;
use Math::BigInt;
use Math::BigFloat;
-my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
-my ($cfg,$x);
-
-foreach my $class ($mbi, $mbf)
- {
- # can do and defaults are okay?
- ok ($class->can('config'), 'can config()');
- is ($class->config()->{trap_nan}, 0, 'trap_nan defaults to 0');
- is ($class->config()->{trap_inf}, 0, 'trap_inf defaults to 0');
-
- # can set?
- $cfg = $class->config( trap_nan => 1 );
- is ($cfg->{trap_nan},1, 'trap_nan now true');
-
- # also test that new() still works normally
- eval ("\$x = \$class->new('42'); \$x->bnan();");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,42,'$x after new() never modified');
-
- # can reset?
- $cfg = $class->config( trap_nan => 0 );
- is ($cfg->{trap_nan}, 0, 'trap_nan disabled');
-
- # can set?
- $cfg = $class->config( trap_inf => 1 );
- is ($cfg->{trap_inf}, 1, 'trap_inf enabled');
-
- eval ("\$x = \$class->new('4711'); \$x->binf();");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,4711,'$x after new() never modified');
-
- eval ("\$x = \$class->new('inf');");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,4711,'$x after new() never modified');
-
- eval ("\$x = \$class->new('-inf');");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,4711,'$x after new() never modified');
-
- # +$x/0 => +inf
- eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,4711,'$x after new() never modified');
-
- # -$x/0 => -inf
- eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,'-815', '$x after new not modified');
-
- $cfg = $class->config( trap_nan => 1 );
- # 0/0 => NaN
- eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
- like ($@, qr/^Tried to set/, 'died');
- is ($x,'0', '$x after new not modified');
- }
+my $mbi = 'Math::BigInt';
+my $mbf = 'Math::BigFloat';
+my ($cfg, $x);
+
+foreach my $class ($mbi, $mbf) {
+ # can do and defaults are okay?
+ ok($class->can('config'), 'can config()');
+ is($class->config()->{trap_nan}, 0, 'trap_nan defaults to 0');
+ is($class->config()->{trap_inf}, 0, 'trap_inf defaults to 0');
+
+ # can set?
+ $cfg = $class->config( trap_nan => 1 );
+ is($cfg->{trap_nan}, 1, 'trap_nan now true');
+
+ # also test that new() still works normally
+ eval ("\$x = \$class->new('42'); \$x->bnan();");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, 42, '$x after new() never modified');
+
+ # can reset?
+ $cfg = $class->config( trap_nan => 0 );
+ is($cfg->{trap_nan}, 0, 'trap_nan disabled');
+
+ # can set?
+ $cfg = $class->config( trap_inf => 1 );
+ is($cfg->{trap_inf}, 1, 'trap_inf enabled');
+
+ eval ("\$x = \$class->new('4711'); \$x->binf();");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, 4711, '$x after new() never modified');
+
+ eval ("\$x = \$class->new('inf');");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, 4711, '$x after new() never modified');
+
+ eval ("\$x = \$class->new('-inf');");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, 4711, '$x after new() never modified');
+
+ # +$x/0 => +inf
+ eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, 4711, '$x after new() never modified');
+
+ # -$x/0 => -inf
+ eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, '-815', '$x after new not modified');
+
+ $cfg = $class->config( trap_nan => 1 );
+ # 0/0 => NaN
+ eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
+ like($@, qr/^Tried to set/, 'died');
+ is($x, '0', '$x after new not modified');
+}
##############################################################################
-# BigInt
+# Math::BigInt
$x = Math::BigInt->new(2);
eval ("\$x = \$mbi->new('0.1');");
-is ($x,2,'never modified since it dies');
+is($x, 2, 'never modified since it dies');
eval ("\$x = \$mbi->new('0a.1');");
-is ($x,2,'never modified since it dies');
+is($x, 2, 'never modified since it dies');
##############################################################################
-# BigFloat
+# Math::BigFloat
$x = Math::BigFloat->new(2);
eval ("\$x = \$mbf->new('0.1a');");
-is ($x,2,'never modified since it dies');
+is($x, 2, 'never modified since it dies');
# all tests done
-
diff --git a/cpan/Math-BigInt/t/upgrade.inc b/cpan/Math-BigInt/t/upgrade.inc
index edb3ce188c..8e77f44d36 100644
--- a/cpan/Math-BigInt/t/upgrade.inc
+++ b/cpan/Math-BigInt/t/upgrade.inc
@@ -1,255 +1,260 @@
# include this file into another for subclass testing
-# This file is nearly identical to bigintpm.t, except that certain results
-# are _requird_ to be different due to "upgrading" or "promoting" to BigFloat.
-# The reverse is not true, any unmarked results can be either BigInt or
-# BigFloat, depending on how good the internal optimization is (e.g. it
-# is usually desirable to have 2 ** 2 return a BigInt, not a BigFloat).
+# This file is nearly identical to bigintpm.t, except that certain results are
+# _requird_ to be different due to "upgrading" or "promoting" to
+# Math::BigFloat. The reverse is not true. Any unmarked results can be either
+# Math::BigInt or Math::BigFloat, depending on how good the internal
+# optimization is (e.g., it is usually desirable to have 2 ** 2 return a
+# Math::BigInt, not a Math::BigFloat).
-# Results that are required to be BigFloat are marked with C<^> at the end.
+# Results that are required to be Math::BigFloat are marked with C<^> at the
+# end.
# Please note that the testcount goes up by two for each extra result marked
# with ^, since then we test whether it has the proper class and that it left
# the upgrade variable alone.
-my $version = ${"$class\::VERSION"};
+use strict;
+use warnings;
+
+our ($CLASS, $CALC, $EXPECTED_CLASS);
##############################################################################
# for testing inheritance of _swap
package Math::Foo;
-use Math::BigInt lib => $main::CL;
-use vars qw/@ISA/;
-@ISA = (qw/Math::BigInt/);
+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])};
+ # 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] );
+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;
-my $CALC = $class->config()->{lib}; is ($CALC,$CL);
+is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}");
-my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class);
+my ($x, $y, $z, @args, $a, $m, $e, $try, $got, $want, $exp);
+my ($f, $round_mode, $expected_class);
-while (<DATA>)
- {
- $_ =~ s/[\n\r]//g; # remove newlines
- next if /^#/; # skip comments
- if (s/^&//)
- {
- $f = $_; next;
+while (<DATA>) {
+ s/#.*$//; # remove comments
+ s/\s+$//; # remove trailing whitespace
+ next unless length; # skip empty lines
+
+ if (s/^&//) {
+ $f = $_;
+ next;
}
- elsif (/^\$/)
- {
- $round_mode = $_; $round_mode =~ s/^\$/$class\->/; next;
+
+ if (/^\$/) {
+ $round_mode = $_;
+ $round_mode =~ s/^\$/$CLASS\->/;
+ next;
}
- @args = split(/:/,$_,99); $ans = pop(@args);
- $expected_class = $class;
- if ($ans =~ /\^$/)
- {
- $expected_class = $ECL; $ans =~ s/\^$//;
+ @args = split(/:/, $_, 99);
+ $want = pop(@args);
+ $expected_class = $CLASS;
+
+ if ($want =~ /\^$/) {
+ $expected_class = $EXPECTED_CLASS;
+ $want =~ s/\^$//;
}
- $try = "\$x = $class->new(\"$args[0]\");";
- if ($f eq "bnorm")
- {
- $try = "\$x = $class->bnorm(\"$args[0]\");";
- # some is_xxx tests
- } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
- $try .= "\$x->$f();";
- } elsif ($f eq "as_hex") {
- $try .= '$x->as_hex();';
- } elsif ($f eq "as_bin") {
- $try .= '$x->as_bin();';
- } 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|fac)$/) {
- $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 .= "\$y = $class->new(\"$args[1]\");"; # BigInt
- }
- else
- {
- $try .= "\$y = $ECL->new(\"$args[1]\");"; # BigFloat
- }
- if ($f eq "bcmp")
- {
- $try .= '$x->bcmp($y);';
- } elsif ($f eq "bround") {
- $try .= "$round_mode; \$x->bround(\$y);";
- } elsif ($f eq "broot") {
- $try .= "\$x->broot(\$y);";
- } elsif ($f eq "bacmp"){
- $try .= '$x->bacmp($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 .= " \$z = $class->new('$args[2]'); ";
- }
- $try .= "$class\::bgcd(\$x, \$y";
- $try .= ", \$z" if (defined $args[2]);
- $try .= " );";
+
+ $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();";
+ } elsif ($f eq "as_hex") {
+ $try .= ' $x->as_hex();';
+ } elsif ($f eq "as_bin") {
+ $try .= ' $x->as_bin();';
+ } 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|fac)$/) {
+ $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") {
+ $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 "digit") {
+ $try = qq|\$x = $CLASS->new("$args[0]"); \$x->digit($args[1]);|;
+ } else {
+ warn "Unknown op '$f'";
}
- elsif ($f eq "blcm")
- {
- if (defined $args[2])
- {
- $try .= " \$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"){
- $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 "digit"){
- $try = "\$x = $class->new('$args[0]'); \$x->digit($args[1]);";
- } else { warn "Unknown op '$f'"; }
- } # end else all other ops
+ } # end else all other ops
- $ans1 = eval $try;
- # convert hex/binary targets to decimal
- if ($ans =~ /^(0x0x|0b0b)/)
- {
- $ans =~ s/^0[xb]//; $ans = Math::BigInt->new($ans)->bstr();
- }
- if ($ans eq "")
- {
- is ($ans1, undef);
+ $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();
}
- else
- {
- # print "try: $try ans: $ans1 $ans\n";
- print "# Tried: '$try'\n" if !is ($ans1, $ans);
- if ($expected_class ne $class)
- {
- is (ref($ans1),$expected_class); # also checks that it really is ref!
- is ($Math::BigInt::upgrade,'Math::BigFloat'); # still okay?
- }
+ if ($want eq "") {
+ is($got, undef, $try);
+ } else {
+ # print "try: $try ans: $got $want\n";
+ is($got, $want, $try);
+ if ($expected_class ne $CLASS) {
+ is(ref($got), $expected_class, 'ref($got)');
+ is($Math::BigInt::upgrade, 'Math::BigFloat',
+ '$Math::BigInt::upgrade');
+ }
}
- # check internal state of number objects
- is_valid($ans1,$f) if ref $ans1;
- } # endwhile data tests
+ # check internal state of number objects
+ is_valid($got, $f) if ref $got;
+} # endwhile data tests
close DATA;
-my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; };
+my $warn = '';
+$SIG{__WARN__} = sub { $warn = shift; };
# these should not warn
-$warn = ''; eval "\$z = 3.17 <= \$y"; is ($z, 1); is ($warn, '');
-$warn = ''; eval "\$z = \$y >= 3.17"; is ($z, 1); is ($warn, '');
+
+$warn = '';
+eval '$z = 3.17 <= $y';
+is($z, 1, '$z = 3.17 <= $y');
+is($warn, '', 'the code "$z = 3.17 <= $y" issued no warning');
+
+$warn = '';
+eval '$z = $y >= 3.17';
+is($z, 1, '$z = $y >= 3.17');
+is($warn, '', 'the code "$z = $y >= 3.17" issued no warning');
# all tests done
1;
###############################################################################
-# sub to check validity of a BigInt internally, to ensure that no op leaves a
-# number object in an invalid state (f.i. "-0")
+# sub to check validity of a Math::BigInt internally, to ensure that no op
+# leaves a number object in an invalid state (f.i. "-0")
+
+sub is_valid {
+ my ($x, $f, $c) = @_;
-sub is_valid
- {
- my ($x,$f,$c) = @_;
+ # The checks here are loosened a bit to allow Math::BigInt or
+ # Math::BigFloats to pass
- # The checks here are loosened a bit to allow BigInt or BigFloats to pass
+ my $e = 0; # error?
- my $e = 0; # error?
- # ok as reference?
- # $e = "Not a reference to $c" if (ref($x) || '') ne $c;
+ # ok as reference?
+ # $e = "Not a reference to $c" if (ref($x) || '') ne $c;
- # has ok sign?
- $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
- if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+ # has ok sign?
+ $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
+ if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
- $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
- #$e = $CALC->_check($x->{value}) if $e eq '0';
+ $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
+ #$e = $CALC->_check($x->{value}) if $e eq '0';
- # test done, see if error did crop up
- is (1,1), return if ($e eq '0');
+ # test done, see if error did crop up
+ if ($e eq '0') {
+ pass('is a valid object');
+ return;
+ }
- is (1,$e." after op '$f'");
- }
+ fail($e . " after op '$f'");
+}
__DATA__
&.=
@@ -558,9 +563,8 @@ NaN::0
+inf:+:1
-inf:-:1
-inf:+:0
-# it must be exactly /^[+-]inf$/
-+infinity::0
--infinity::0
++iNfInItY::1
+-InFiNiTy::1
&blsft
abc:abc:NaN
+2:+2:8
diff --git a/cpan/Math-BigInt/t/upgrade.t b/cpan/Math-BigInt/t/upgrade.t
index d209879a89..2307a48c29 100644
--- a/cpan/Math-BigInt/t/upgrade.t
+++ b/cpan/Math-BigInt/t/upgrade.t
@@ -1,19 +1,22 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
-use Test::More tests => 2124
- + 2; # our own tests
+use warnings;
+
+use Test::More tests => 2124 # tests in require'd file
+ + 2; # tests in this file
use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat;
-use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup
- $ECL $CL);
-$class = "Math::BigInt";
-$CL = "Math::BigInt::Calc";
-$ECL = "Math::BigFloat";
+our ($CLASS, $EXPECTED_CLASS, $CALC);
+$CLASS = "Math::BigInt";
+$EXPECTED_CLASS = "Math::BigFloat";
+$CALC = "Math::BigInt::Calc"; # backend
-is (Math::BigInt->upgrade(),'Math::BigFloat');
-is (Math::BigInt->downgrade()||'','');
+is(Math::BigInt->upgrade(), "Math::BigFloat",
+ qq/Math::BigInt->upgrade()/);
+is(Math::BigInt->downgrade() || "", "",
+ qq/Math::BigInt->downgrade() || ""/);
require 't/upgrade.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/upgrade2.t b/cpan/Math-BigInt/t/upgrade2.t
index cdc8d0edf4..5009d61678 100644
--- a/cpan/Math-BigInt/t/upgrade2.t
+++ b/cpan/Math-BigInt/t/upgrade2.t
@@ -1,4 +1,7 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
+
+use strict;
+use warnings;
# Test 2 levels of upgrade classes. This used to cause a segv.
diff --git a/cpan/Math-BigInt/t/upgradef.t b/cpan/Math-BigInt/t/upgradef.t
index 611d9fad27..d2088903df 100644
--- a/cpan/Math-BigInt/t/upgradef.t
+++ b/cpan/Math-BigInt/t/upgradef.t
@@ -1,6 +1,8 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
+use warnings;
+
use Test::More tests => 6;
###############################################################################
@@ -8,27 +10,23 @@ package Math::BigFloat::Test;
use Math::BigFloat;
require Exporter;
-use vars qw/@ISA/;
-@ISA = qw/Exporter Math::BigFloat/;
+our @ISA = qw/Exporter Math::BigFloat/;
use overload;
-sub isa
- {
- my ($self,$class) = @_;
- return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these
- UNIVERSAL::isa($self,$class);
- }
+sub isa {
+ my ($self, $class) = @_;
+ return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these
+ UNIVERSAL::isa($self, $class);
+}
-sub bmul
- {
- return __PACKAGE__->new(123);
- }
+sub bmul {
+ return __PACKAGE__->new(123);
+}
-sub badd
- {
- return __PACKAGE__->new(321);
- }
+sub badd {
+ return __PACKAGE__->new(321);
+}
###############################################################################
package main;
@@ -36,22 +34,37 @@ package main;
# use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat upgrade => 'Math::BigFloat::Test';
-use vars qw ($scale $class $try $x $y $z $f @args $ans $ans1 $ans1_str $setup
- $ECL $CL);
-$class = "Math::BigFloat";
-$CL = "Math::BigInt::Calc";
-$ECL = "Math::BigFloat::Test";
-
-is (Math::BigFloat->upgrade(),$ECL);
-is (Math::BigFloat->downgrade()||'','');
-
-$x = $class->new(123); $y = $ECL->new(123); $z = $x->bmul($y);
-is (ref($z),$ECL); is ($z,123);
-
-$x = $class->new(123); $y = $ECL->new(123); $z = $x->badd($y);
-is (ref($z),$ECL); is ($z,321);
-
-
+my ($x, $y, $z);
+
+our ($CLASS, $EXPECTED_CLASS, $CALC);
+$CLASS = "Math::BigFloat";
+$EXPECTED_CLASS = "Math::BigFloat::Test";
+$CALC = "Math::BigInt::Calc"; # backend
+
+is(Math::BigFloat->upgrade(), $EXPECTED_CLASS,
+ qq|Math::BigFloat->upgrade()|);
+is(Math::BigFloat->downgrade() || '', '',
+ qq/Math::BigFloat->downgrade() || ''/);
+
+$x = $CLASS->new(123);
+$y = $EXPECTED_CLASS->new(123);
+$z = $x->bmul($y);
+is(ref($z), $EXPECTED_CLASS,
+ qq|\$x = $CLASS->new(123); \$y = $EXPECTED_CLASS->new(123);|
+ . q| $z = $x->bmul($y); ref($z)|);
+is($z, 123,
+ qq|\$x = $CLASS->new(123); \$y = $EXPECTED_CLASS->new(123);|
+ . q| $z = $x->bmul($y); $z|);
+
+$x = $CLASS->new(123);
+$y = $EXPECTED_CLASS->new(123);
+$z = $x->badd($y);
+is(ref($z), $EXPECTED_CLASS,
+ qq|$x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123);|
+ . q| $z = $x->badd($y); ref($z)|);
+is($z, 321,
+ qq|$x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123);|
+ . q| $z = $x->badd($y); $z|);
# not yet:
-# require 'upgrade.inc'; # all tests here for sharing
+#require 't/upgrade.inc'; # all tests here for sharing
diff --git a/cpan/Math-BigInt/t/use.t b/cpan/Math-BigInt/t/use.t
index 3d0b9e2cd6..d04a11afc1 100644
--- a/cpan/Math-BigInt/t/use.t
+++ b/cpan/Math-BigInt/t/use.t
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# use Module(); doesn't call import() - thanx for cpan testers David. M. Town
# and Andreas Marcel Riechert for spotting it. It is fixed by the same code
@@ -6,14 +6,14 @@
# works.
use strict;
-use Test::More tests => 1;
-
-my ($try,$ans,$x);
+use warnings;
-use Math::BigInt(); $x = Math::BigInt->new(1); ++$x;
+use Test::More tests => 1;
-is ($x,2);
+my $x;
-# all tests done
+use Math::BigInt ();
+$x = Math::BigInt->new(1);
+++$x;
-1;
+is($x, 2, '$x = Math::BigInt->new(1); ++$x;');
diff --git a/cpan/Math-BigInt/t/use_lib1.t b/cpan/Math-BigInt/t/use_lib1.t
index 2045af1833..5737470a1a 100644
--- a/cpan/Math-BigInt/t/use_lib1.t
+++ b/cpan/Math-BigInt/t/use_lib1.t
@@ -1,15 +1,19 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
+use warnings;
+
use Test::More tests => 2;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigFloat lib => 'BareCalc';
-is (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigInt->config()->{lib}');
-is (Math::BigFloat->new(123)->badd(123),246);
+is(Math::BigFloat->new(123)->badd(123), 246,
+ 'Math::BigFloat->new(123)->badd(123)');
diff --git a/cpan/Math-BigInt/t/use_lib2.t b/cpan/Math-BigInt/t/use_lib2.t
index 23239e10e9..d66d7b25eb 100644
--- a/cpan/Math-BigInt/t/use_lib2.t
+++ b/cpan/Math-BigInt/t/use_lib2.t
@@ -1,16 +1,20 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
+use warnings;
+
use Test::More tests => 2;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigInt;
use Math::BigFloat lib => 'BareCalc';
-is (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigInt->config()->{lib}');
-is (Math::BigFloat->new(123)->badd(123),246);
+is(Math::BigFloat->new(123)->badd(123), 246,
+ 'Math::BigFloat->new(123)->badd(123)');
diff --git a/cpan/Math-BigInt/t/use_lib3.t b/cpan/Math-BigInt/t/use_lib3.t
index 95263a0dcd..4bb6cd5e49 100644
--- a/cpan/Math-BigInt/t/use_lib3.t
+++ b/cpan/Math-BigInt/t/use_lib3.t
@@ -1,16 +1,20 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent
use strict;
+use warnings;
+
use Test::More tests => 2;
-BEGIN { unshift @INC, 't'; }
+use lib 't';
use Math::BigInt lib => 'BareCalc';
use Math::BigFloat;
-is (Math::BigInt->config()->{lib},'Math::BigInt::BareCalc');
+is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigInt->config()->{lib}');
-is (Math::BigFloat->new(123)->badd(123),246);
+is(Math::BigFloat->new(123)->badd(123), 246,
+ 'Math::BigFloat->new(123)->badd(123)');
diff --git a/cpan/Math-BigInt/t/use_lib4.t b/cpan/Math-BigInt/t/use_lib4.t
index a0d0564a35..78fa87aa0a 100644
--- a/cpan/Math-BigInt/t/use_lib4.t
+++ b/cpan/Math-BigInt/t/use_lib4.t
@@ -1,17 +1,20 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# see if using Math::BigInt and Math::BigFloat works together nicely.
# all use_lib*.t should be equivalent, except this, since the later overrides
# the former lib statement
use strict;
-use Test::More tests => 2;
+use warnings;
+use lib 't';
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 2;
use Math::BigInt lib => 'BareCalc';
use Math::BigFloat lib => 'Calc';
-is (Math::BigInt->config()->{lib},'Math::BigInt::Calc');
+is(Math::BigInt->config()->{lib}, 'Math::BigInt::Calc',
+ 'Math::BigInt->config()->{lib}');
-is (Math::BigFloat->new(123)->badd(123),246);
+is(Math::BigFloat->new(123)->badd(123), 246,
+ 'Math::BigFloat->new(123)->badd(123)');
diff --git a/cpan/Math-BigInt/t/use_mbfw.t b/cpan/Math-BigInt/t/use_mbfw.t
index afa3733250..da071f41c8 100644
--- a/cpan/Math-BigInt/t/use_mbfw.t
+++ b/cpan/Math-BigInt/t/use_mbfw.t
@@ -1,26 +1,32 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# check that using BigFloat with "with" and "lib" at the same time works
+# check that using Math::BigFloat with "with" and "lib" at the same time works
# broken in versions up to v1.63
use strict;
-use Test::More tests => 2;
+use warnings;
+
+use lib 't';
-BEGIN { unshift @INC, 't'; }
+use Test::More tests => 2;
-# the replacement lib can handle the lib statement, but it could also ignore
-# it completely, for instance, when it is a 100% replacement for BigInt, but
-# doesn't know the concept of alternative libs. But it still needs to cope
-# with "lib => ". SubClass does record it, so we test here essential if
-# BigFloat hands the lib properly down, any more is outside out testing reach.
+# the replacement lib can handle the lib statement, but it could also ignore it
+# completely, for instance, when it is a 100% replacement for Math::BigInt, but
+# doesn't know the concept of alternative libs. But it still needs to cope with
+# "lib => ". SubClass does record it, so we test here essential if
+# Math::BigFloat hands the lib properly down, any more is outside out testing
+# reach.
-use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc';
+use Math::BigFloat with => 'Math::BigInt::Subclass',
+ lib => 'BareCalc';
-is (Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc' );
+is(Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc',
+ 'Math::BigFloat->config()->{with}');
-# is ($Math::BigInt::Subclass::lib, 'BareCalc' );
+# is($Math::BigInt::Subclass::lib, 'BareCalc');
# it never arrives here, but that is a design decision in SubClass
-is (Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc' );
+is(Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc',
+ 'Math::BigInt->config->{lib}');
# all tests done
diff --git a/cpan/Math-BigInt/t/with_sub.t b/cpan/Math-BigInt/t/with_sub.t
index 85d832d15d..a1c9f65fae 100644
--- a/cpan/Math-BigInt/t/with_sub.t
+++ b/cpan/Math-BigInt/t/with_sub.t
@@ -1,17 +1,22 @@
-#!/usr/bin/perl -w
+#!perl
# Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass';
use strict;
-use Test::More tests => 2363 + 1;
+use warnings;
-use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'Calc';
+use Test::More tests => 2409 # tests in require'd file
+ + 1; # tests in this file
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
-$class = "Math::BigFloat";
-$CL = "Math::BigInt::Calc";
+use Math::BigFloat with => 'Math::BigInt::Subclass',
+ lib => 'Calc';
+
+our ($CLASS, $CALC);
+$CLASS = "Math::BigFloat";
+$CALC = "Math::BigInt::Calc"; # backend
# the with argument is ignored
-is (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc');
+is(Math::BigFloat->config()->{with}, 'Math::BigInt::Calc',
+ 'Math::BigFloat->config()->{with}');
require 't/bigfltpm.inc'; # all tests here for sharing