summaryrefslogtreecommitdiff
path: root/lib/Math
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-11-04 16:52:45 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-11-04 16:52:45 +0000
commitdccbb85364264831140cc0a7f1548b3b0afa23c5 (patch)
tree5dce0300eb3b313589a1f04c100d99280a83f28d /lib/Math
parent9b5c89798cac25472c30cfc655e92d420ec36862 (diff)
downloadperl-dccbb85364264831140cc0a7f1548b3b0afa23c5.tar.gz
Upgrade to Math::BigInt 1.45; from Tels.
NOTE: some of the tests are failing but that's because the core integration is not yet done. p4raw-id: //depot/perl@12843
Diffstat (limited to 'lib/Math')
-rw-r--r--lib/Math/BigInt.pm357
-rw-r--r--lib/Math/BigInt/Calc.pm95
-rw-r--r--lib/Math/BigInt/t/Math/BigFloat/Subclass.pm (renamed from lib/Math/BigInt/t/Math/Subclass.pm)12
-rw-r--r--lib/Math/BigInt/t/Math/BigInt/Subclass.pm56
-rwxr-xr-xlib/Math/BigInt/t/bigfltpm.t4
-rw-r--r--lib/Math/BigInt/t/calling.t64
-rw-r--r--lib/Math/BigInt/t/mbimbf.t81
-rwxr-xr-x[-rw-r--r--]lib/Math/BigInt/t/sub_mbf.t (renamed from lib/Math/BigInt/t/subclass.t)15
-rwxr-xr-xlib/Math/BigInt/t/sub_mbi.t35
9 files changed, 516 insertions, 203 deletions
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 8aab185607..f854ec0747 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -19,7 +19,7 @@ package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.44';
+$VERSION = '1.45';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
@@ -391,7 +391,6 @@ sub new
}
$self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
$self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
- #print "$wanted => $self->{sign}\n";
# if any of the globals is set, use them to round and store them inside $self
$self->round($accuracy,$precision,$round_mode)
if defined $accuracy || defined $precision;
@@ -443,7 +442,6 @@ sub bzero
return if $self->modify('bzero');
$self->{value} = $CALC->_zero();
$self->{sign} = '+';
- #print "result: $self\n";
return $self;
}
@@ -454,7 +452,6 @@ sub bone
my $self = shift;
my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
$self = $class if !defined $self;
- #print "bone $self\n";
if (!ref($self))
{
@@ -463,7 +460,6 @@ sub bone
return if $self->modify('bone');
$self->{value} = $CALC->_one();
$self->{sign} = $sign;
- #print "result: $self\n";
return $self;
}
@@ -475,12 +471,8 @@ 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")
-# print "bsstr $_[0] $_[1]\n";
-# my $x = shift; $class = ref($x) || $x;
-# print "class $class $x (",ref($x),") $_[0]\n";
-# $x = $class->new(shift) if !ref($x);
-#
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
+ # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
@@ -585,7 +577,6 @@ sub _find_round_parameters
my @params = ($self);
if (defined $a || defined $p)
{
-# print "r => ",$r||'r undef'," in $c\n";
$r = $r || ${"$c\::round_mode"};
die "Unknown round mode '$r'"
if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
@@ -619,8 +610,8 @@ sub bnorm
{
# (numstr or or BINT) return BINT
# Normalize number -- no-op here
- return Math::BigInt->new($_[0]) if !ref($_[0]);
- return $_[0];
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ return $x;
}
sub babs
@@ -674,8 +665,19 @@ sub bcmp
return 0 if $xz && $yz; # 0 <=> 0
return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
- # normal compare now
- &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
+
+ # post-normalized compare for internal use (honors signs)
+ if ($x->{sign} eq '+')
+ {
+ return 1 if $y->{sign} eq '-'; # 0 check handled above
+ return $CALC->_acmp($x->{value},$y->{value});
+ }
+
+ # $x->{sign} eq '-'
+ return -1 if $y->{sign} eq '+';
+ return $CALC->_acmp($y->{value},$x->{value}); # swaped
+
+ # &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
}
sub bacmp
@@ -808,7 +810,7 @@ sub blcm
{
$x = $class->new($y);
}
- while (@_) { $x = _lcm($x,shift); }
+ while (@_) { $x = __lcm($x,shift); }
$x;
}
@@ -818,21 +820,15 @@ sub bgcd
# does not modify arguments, but returns new object
# GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff)
- my $y = shift; my ($x);
- if (ref($y))
- {
- $x = $y->copy();
- }
- else
- {
- $x = $class->new($y);
- }
-
+ my $y = shift;
+ $y = __PACKAGE__->new($y) if !ref($y);
+ my $self = ref($y);
+ my $x = $y->copy(); # keep arguments
if ($CALC->can('_gcd'))
{
while (@_)
{
- $y = shift; $y = $class->new($y) if !ref($y);
+ $y = shift; $y = $self->new($y) if !ref($y);
next if $y->is_zero();
return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
$x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
@@ -842,22 +838,13 @@ sub bgcd
{
while (@_)
{
- $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
+ $y = shift; $y = $self->new($y) if !ref($y);
+ $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
}
}
$x->babs();
}
-sub bmod
- {
- # modulus
- # (BINT or num_str, BINT or num_str) return BINT
- my ($self,$x,$y) = objectify(2,@_);
-
- return $x if $x->modify('bmod');
- (&bdiv($self,$x,$y))[1];
- }
-
sub bnot
{
# (num_str or BINT) return BINT
@@ -985,8 +972,79 @@ sub bmul
}
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
+
$x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
return $x->round($a,$p,$r,$y);
+
+ # from http://groups.google.com/groups?selm=3BBF69A6.72E1%40pointecom.net
+ #
+ # my $yc = $y->copy(); # make copy of second argument
+ # my $carry = $self->bzero();
+ #
+ # # XXX
+ # while ($yc > 1)
+ # {
+ # #print "$x\t$yc\t$carry\n";
+ # $carry += $x if $yc->is_odd();
+ # $yc->brsft(1,2);
+ # $x->blsft(1,2);
+ # }
+ # $x += $carry;
+ # #print "result $x\n";
+ #
+ # return $x->round($a,$p,$r,$y);
+ }
+
+sub _div_inf
+ {
+ # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
+ my ($self,$x,$y) = @_;
+
+ # NaN if x == NaN or y == NaN or x==y==0
+ return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
+ if (($x->is_nan() || $y->is_nan()) ||
+ ($x->is_zero() && $y->is_zero()));
+
+ # +inf / +inf == -inf / -inf == 1, remainder is 0 (A / A = 1, remainder 0)
+ if (($x->{sign} eq $y->{sign}) &&
+ ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ return wantarray ? ($x->bone(),$self->bzero()) : $x->bone();
+ }
+ # +inf / -inf == -inf / +inf == -1, remainder 0
+ if (($x->{sign} ne $y->{sign}) &&
+ ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ return wantarray ? ($x->bone('-'),$self->bzero()) : $x->bone('-');
+ }
+ # x / +-inf => 0, remainder x (works even if x == 0)
+ if ($y->{sign} =~ /^[+-]inf$/)
+ {
+ my $t = $x->copy(); # binf clobbers up $x
+ return wantarray ? ($x->bzero(),$t) : $x->bzero()
+ }
+
+ # 5 / 0 => +inf, -6 / 0 => -inf
+ # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
+ # exception: -8 / 0 has remainder -8, not 8
+ # exception: -inf / 0 has remainder -inf, not inf
+ if ($y->is_zero())
+ {
+ # +-inf / 0 => special case for -inf
+ return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
+ if (!$x->is_zero() && !$x->is_inf())
+ {
+ my $t = $x->copy(); # binf clobbers up $x
+ return wantarray ?
+ ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
+ }
+ }
+
+ # last case: +-inf / ordinary number
+ my $sign = '+inf';
+ $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
+ $x->{sign} = $sign;
+ return wantarray ? ($x,$self->bzero()) : $x;
}
sub bdiv
@@ -997,23 +1055,8 @@ sub bdiv
return $x if $x->modify('bdiv');
- # x / +-inf => 0, reminder x
- return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
- if $y->{sign} =~ /^[+-]inf$/;
-
- # NaN if x == NaN or y == NaN or x==y==0
- return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if (($x->is_nan() || $y->is_nan()) ||
- ($x->is_zero() && $y->is_zero()));
-
- # 5 / 0 => +inf, -6 / 0 => -inf
- return wantarray
- ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
- if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
-
- # old code: always NaN if /0
- #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
- # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
+ return $self->_div_inf($x,$y)
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
# 0 / something
return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
@@ -1035,36 +1078,74 @@ sub bdiv
}
# calc new sign and in case $y == +/- 1, return $x
+ my $xsign = $x->{sign}; # keep
$x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
# check for / +-1 (cant use $y->is_one due to '-'
- if (($y == 1) || ($y == -1)) # slow!
- #if ((@{$y->{value}} == 1) && ($y->{value}->[0] == 1))
+ if (($y == 1) || ($y == -1)) # slow!
{
return wantarray ? ($x,$self->bzero()) : $x;
}
# call div here
my $rem = $self->bzero();
- $rem->{sign} = $y->{sign};
($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
- # do not leave reminder "-0";
- # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0);
- $rem->{sign} = '+' if $CALC->_is_zero($rem->{value});
- if (($x->{sign} eq '-') and (!$rem->is_zero()))
- {
- $x->bdec();
- }
-# print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n";
+ # do not leave result "-0";
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value});
$x->round($a,$p,$r,$y);
+
+# print "in div round ",$a||'a undef'," ",$p|| 'p undef'," $r\n";
if (wantarray)
{
- $rem->round($a,$p,$r,$x,$y);
- return ($x,$y-$rem) if $x->{sign} eq '-'; # was $x,$rem
+ if (! $CALC->_is_zero($rem->{value}))
+ {
+ $rem->{sign} = $y->{sign};
+ $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
+ }
+ else
+ {
+ $rem->{sign} = '+'; # dont leave -0
+ }
+ $rem->round($a,$p,$r,$x,$y);
return ($x,$rem);
}
return $x;
}
+sub bmod
+ {
+ # modulus (or remainder)
+ # (BINT or num_str, BINT or num_str) return BINT
+ my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ return $x if $x->modify('bmod');
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
+ {
+ my ($d,$r) = $self->_div_inf($x,$y);
+ return $r;
+ }
+
+ if ($CALC->can('_mod'))
+ {
+ # calc new sign and in case $y == +/- 1, return $x
+ $x->{value} = $CALC->_mod($x->{value},$y->{value});
+ my $xsign = $x->{sign};
+ if (!$CALC->_is_zero($x->{value}))
+ {
+ $x->{sign} = $y->{sign};
+ $x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
+ }
+ else
+ {
+ $x->{sign} = '+'; # dont leave -0
+ }
+ }
+ else
+ {
+ $x = (&bdiv($self,$x,$y))[1];
+ }
+ $x->bround($a,$p,$r);
+ }
+
sub bpow
{
# (BINT or num_str, BINT or num_str) return BINT
@@ -1115,18 +1196,20 @@ sub bpow
my $pow2 = $self->__one();
my $y1 = $class->new($y);
my ($res);
+ my $two = $self->new(2);
while (!$y1->is_one())
{
- #print "bpow: p2: $pow2 x: $x y: $y1 r: $res\n";
- #print "len ",$x->length(),"\n";
- ($y1,$res)=&bdiv($y1,2);
- if (!$res->is_zero()) { &bmul($pow2,$x); }
- if (!$y1->is_zero()) { &bmul($x,$x); }
- #print "$x $y\n";
+ # thats a tad (between 8 and 17%) faster for small results
+ # 7777 ** 7777 is not faster, but 2 ** 150, 3 ** 16, 3 ** 256 etc are
+ $pow2->bmul($x) if $y1->is_odd();
+ $y1->bdiv($two);
+ $x->bmul($x) unless $y1->is_zero();
+
+ # ($y1,$res)=&bdiv($y1,2);
+ # if (!$res->is_zero()) { &bmul($pow2,$x); }
+ # if (!$y1->is_zero()) { &bmul($x,$x); }
}
- #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
- &bmul($x,$pow2) if (!$pow2->is_one());
- #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n";
+ $x->bmul($pow2) unless $pow2->is_one();
return $x->round($a,$p,$r);
}
@@ -1249,7 +1332,6 @@ sub bior
$x->badd( bmul( $class->new(
abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
$m));
-# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m));
$m->bmul($x10000);
}
$x->bneg() if $sign;
@@ -1294,7 +1376,6 @@ sub bxor
$x->badd( bmul( $class->new(
abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
$m));
-# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m));
$m->bmul($x10000);
}
$x->bneg() if $sign;
@@ -1306,9 +1387,6 @@ sub length
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
my $e = $CALC->_len($x->{value});
- # # fallback, since we do not know the underlying representation
- #my $es = "$x"; my $c = 0; $c = 1 if $es =~ /^[+-]/; # if lib returns '+123'
- #my $e = CORE::length($es)-$c;
return wantarray ? ($e,0) : $e;
}
@@ -1327,8 +1405,7 @@ sub _trailing_zeros
my $x = shift;
$x = $class->new($x) unless ref $x;
- #return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
- return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
@@ -1415,7 +1492,7 @@ sub bfround
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 || $n == 1 => round to integer
my $x = shift; $x = $class->new($x) unless ref $x;
- my ($scale,$mode) = $x->_scale_p($precision,$round_mode,@_);
+ my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
return $x if !defined $scale; # no-op
# no-op for BigInts if $n <= 0
@@ -1464,7 +1541,7 @@ sub bround
# and overwrite the rest with 0's, return normalized number
# do not return $x->bnorm(), but $x
my $x = shift; $x = $class->new($x) unless ref $x;
- my ($scale,$mode) = $x->_scale_a($accuracy,$round_mode,@_);
+ my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
return $x if !defined $scale; # no-op
# print "MBI round: $x to $scale $mode\n";
@@ -1605,7 +1682,7 @@ sub __one
{
# internal speedup, set argument to 1, or create a +/- 1
my $self = shift;
- my $x = $self->bzero(); $x->{value} = $CALC->_one();
+ my $x = $self->bone(); # $x->{value} = $CALC->_one();
$x->{sign} = shift || '+';
return $x;
}
@@ -1673,7 +1750,7 @@ sub objectify
my $count = abs(shift || 0);
- #print caller(),"\n";
+# print "MBI ",caller(),"\n";
my @a; # resulting array
if (ref $_[0])
@@ -1715,7 +1792,7 @@ sub objectify
#print "$count\n";
$count--;
$k = shift;
- # print "$k (",ref($k),") => \n";
+# print "$k (",ref($k),") => \n";
if (!ref($k))
{
$k = $a[0]->new($k);
@@ -1765,8 +1842,8 @@ sub import
}
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
- #$self->SUPER::import(@a); # does not work
- $self->export_to_level(1,$self,@a); # need this instead
+ $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;
@@ -1872,7 +1949,7 @@ sub _split
{
# (ref to num_str) return num_str
# internal, take apart a string and return the pieces
- # strip leading/trailing whitespace, leading zeros, underscore, reject
+ # strip leading/trailing whitespace, leading zeros, underscore and reject
# invalid input
my $x = shift;
@@ -2005,28 +2082,7 @@ sub as_bin
##############################################################################
# internal calculation routines (others are in Math::BigInt::Calc etc)
-sub cmp
- {
- # post-normalized compare for internal use (honors signs)
- # input: ref to value, ref to value, sign, sign
- # output: <0, 0, >0
- my ($cx,$cy,$sx,$sy) = @_;
-
- if ($sx eq '+')
- {
- return 1 if $sy eq '-'; # 0 check handled above
- return $CALC->_acmp($cx,$cy);
- }
- else
- {
- # $sx eq '-'
- return -1 if $sy eq '+';
- return $CALC->_acmp($cy,$cx);
- }
- 0; # equal
- }
-
-sub _lcm
+sub __lcm
{
# (BINT or num_str, BINT or num_str) return BINT
# does modify first argument
@@ -2040,10 +2096,10 @@ sub _lcm
sub __gcd
{
# (BINT or num_str, BINT or num_str) return BINT
- # does modify first arg
+ # does modify both arguments
# GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
-
- my $x = shift; my $ty = $class->new(shift); # preserve y, but make class
+ my ($x,$ty) = @_;
+
return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
while (!$ty->is_zero())
@@ -2142,8 +2198,8 @@ Math::BigInt - Arbitrary size integer math package
# The following do not modify their arguments:
- bgcd(@values); # greatest common divisor
- blcm(@values); # lowest common multiplicator
+ bgcd(@values); # greatest common divisor (no OO style)
+ blcm(@values); # lowest common multiplicator (no OO style)
$x->length(); # return number of digits in number
($x,$f) = $x->length(); # length of number and length of fraction part,
@@ -2375,7 +2431,7 @@ versions <= 5.7.2) is like this:
again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange
assumption that 124 has 3 significant digits, while 120/7 will get you
'17', not '17.1' since 120 is thought to have 2 significant digits.
- The rounding after the division then uses the reminder and $y to determine
+ The rounding after the division then uses the remainder and $y to determine
wether it must round up or down.
? I have no idea which is the right way. That's why I used a slightly more
? simple scheme and tweaked the few failing testcases to match it.
@@ -2818,7 +2874,7 @@ This also works for other subclasses, like Math::String.
It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
-=item bdiv
+=item length
The following will probably not do what you expect:
@@ -2836,7 +2892,7 @@ The following will probably not do what you expect:
print $c->bdiv(10000),"\n";
-It prints both quotient and reminder since print calls C<bdiv()> in list
+It prints both quotient and remainder since print calls C<bdiv()> in list
context. Also, C<bdiv()> will modify $c, so be carefull. You probably want
to use
@@ -2850,10 +2906,12 @@ real-valued quotient of the two operands, and the remainder (when it is
nonzero) 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)
+ 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
@@ -2862,7 +2920,9 @@ manpage), and the equation
$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.
+values of bdiv() the quotient and remainder. The only exception to this rule
+are when $y == 0 and $x is negative, then the remainder will also be
+negative. See below under "infinity handling" for the reasoning behing this.
Perl's 'use integer;' changes the behaviour of % and / for scalars, but will
not change BigInt's way to do things. This is because under 'use integer' Perl
@@ -2870,6 +2930,47 @@ will do what the underlying C thinks is right and this is different for each
system. If you need BigInt's behaving exactly like Perl's 'use integer', bug
the author to implement it ;)
+=item infinity handling
+
+Here are some examples that explain the reasons why certain results occur while
+handling infinity:
+
+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
+ =========================================================
+ 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
+ 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
+ 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
+ ========================================================
+ -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
+ -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
+
=item Modifying and =
Beware of:
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index a2b73e0ac3..e7754bd35b 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -8,7 +8,7 @@ require Exporter;
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.12';
+$VERSION = '0.13';
# Package to store unsigned big integers in decimal and do math with them
@@ -29,14 +29,16 @@ $VERSION = '0.12';
# constants for easier life
my $nan = 'NaN';
-
my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL);
sub _base_len
{
+ # set/get the BASE_LEN and assorted other, connected values
+ # used only be the testsuite, set is used only by the BEGIN block below
my $b = shift;
if (defined $b)
{
+ $b = 8 if $b > 8; # cap, for VMS, OS/390 and other 64 bit
$BASE_LEN = $b;
$BASE = int("1e".$BASE_LEN);
$RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
@@ -46,36 +48,35 @@ sub _base_len
if (int($BASE * $RBASE) == 0) # should be 1
{
# must USE_MUL
- # print "use mul\n";
*{_mul} = \&_mul_use_mul;
*{_div} = \&_div_use_mul;
}
else
{
- # print "use div\n";
# can USE_DIV instead
*{_mul} = \&_mul_use_div;
*{_div} = \&_div_use_div;
}
}
- $BASE_LEN-1;
+ $BASE_LEN;
}
BEGIN
{
# from Daniel Pfeiffer: determine largest group of digits that is precisely
# multipliable with itself plus carry
- my ($e, $num) = 4;
+ # 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;
- } until ($num == $num - 1 or $num - 1 == $num - 2);
+ # print "$num $e\n";
+ } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern
+ # last test failed, so retract one step:
_base_len($e-1);
}
-# for quering and setting, to debug/benchmark things
-
##############################################################################
# create objects from various representations
@@ -229,7 +230,7 @@ sub _mul_use_mul
# multiply two numbers in internal representation
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
-
+
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if "$xv" eq "$yv"; # same references?
@@ -477,6 +478,58 @@ sub _div_use_div
return $x;
}
+sub _mod
+ {
+ # if possible, use mod shortcut
+ my ($c,$x,$yo) = @_;
+
+ # slow way since $y to big
+ if (scalar @$yo > 1)
+ {
+ my ($xo,$rem) = _div($c,$x,$yo);
+ return $rem;
+ }
+ my $y = $yo->[0];
+ # both are single element
+ if (scalar @$x == 1)
+ {
+ $x->[0] %= $y;
+ return $x;
+ }
+
+ 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;
+ }
+ else
+ {
+ # else need to go trough all elemens: O(N)
+ # XXX not ready yet
+ my ($xo,$rem) = _div($c,$x,$yo);
+ return $rem;
+
+# my $i = 0; my $r = 1;
+# print "Multi: ";
+# foreach (@$x)
+# {
+# print "$_ $r $b $y\n";
+# print "\$_ % \$y = ",$_ % $y,"\n";
+# print "\$_ % \$y * \$b = ",($_ % $y) * $b,"\n";
+# $r += ($_ % $y) * $b;
+# print "$r $b $y =>";
+# $r %= $y if $r > $y;
+# print " $r\n";
+# }
+# $x->[0] = $r;
+ }
+ splice (@$x,1);
+ return $x;
+ }
+
##############################################################################
# shifts
@@ -494,7 +547,7 @@ sub _rsft
# multiples of $BASE_LEN
my $dst = 0; # destination
my $src = _num($c,$y); # as normal int
- my $rem = $src % $BASE_LEN; # reminder to shift
+ my $rem = $src % $BASE_LEN; # remainder to shift
$src = int($src / $BASE_LEN); # source
if ($rem == 0)
{
@@ -540,7 +593,7 @@ sub _lsft
# multiples of $BASE_LEN:
my $src = scalar @$x; # source
my $len = _num($c,$y); # shift-len as normal int
- my $rem = $len % $BASE_LEN; # reminder to shift
+ my $rem = $len % $BASE_LEN; # remainder to shift
my $dst = $src + int($len/$BASE_LEN); # destination
my $vd; # further speedup
#print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n";
@@ -612,9 +665,9 @@ sub _acmp
sub _len
{
- # computer number of digits in bigint, minus the sign
+ # compute number of digits in bigint, minus the sign
# int() because add/sub sometimes leaves strings (like '00005') instead of
- # int ('5') in this place, causing length to fail
+ # int ('5') in this place, thus causing length() to report wrong length
my $cx = $_[1];
return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
@@ -729,6 +782,10 @@ sub _check
$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
@@ -820,13 +877,16 @@ slow, Perl way as fallback to emulate these:
'0b' must be prepended.
_rsft(obj,N,B) shift object in base B by N 'digits' right
+ For unsupported bases B, return undef to signal failure
_lsft(obj,N,B) shift object in base B by N 'digits' left
+ For unsupported bases B, return undef to signal failure
_xor(obj1,obj2) XOR (bit-wise) object 1 with object 2
- Mote: XOR, AND and OR pad with zeros if size mismatches
+ Note: XOR, AND and OR pad with zeros if size mismatches
_and(obj1,obj2) AND (bit-wise) object 1 with object 2
_or(obj1,obj2) OR (bit-wise) object 1 with object 2
+ _mod(obj,obj) Return remainder of div of the 1st by the 2nd object
_sqrt(obj) return the square root of object
_pow(obj,obj) return object 1 to the power of object 2
_gcd(obj,obj) return Greatest Common Divisor of two objects
@@ -845,12 +905,13 @@ zero or similar cases.
The first parameter can be modified, that includes the possibility that you
return a reference to a completely different object instead. Although keeping
-the reference is prefered over creating and returning a different one.
+the reference and just changing it's contents is prefered over creating and
+returning a different reference.
Return values are always references to objects or strings. Exceptions are
C<_lsft()> and C<_rsft()>, which return undef if they can not shift the
argument. This is used to delegate shifting of bases different than 10 back
-to BigInt, which will use some generic code to calculate the result.
+to Math::BigInt, which will use some generic code to calculate the result.
=head1 WRAP YOUR OWN
diff --git a/lib/Math/BigInt/t/Math/Subclass.pm b/lib/Math/BigInt/t/Math/BigFloat/Subclass.pm
index c78731cfc7..7a1c2790cc 100644
--- a/lib/Math/BigInt/t/Math/Subclass.pm
+++ b/lib/Math/BigInt/t/Math/BigFloat/Subclass.pm
@@ -1,25 +1,17 @@
#!/usr/bin/perl -w
-package Math::Subclass;
+package Math::BigFloat::Subclass;
require 5.005_02;
use strict;
use Exporter;
use Math::BigFloat(1.23);
-use vars qw($VERSION @ISA @EXPORT
- @EXPORT_OK %EXPORT_TAGS $PACKAGE
+use vars qw($VERSION @ISA $PACKAGE
$accuracy $precision $round_mode $div_scale);
@ISA = qw(Exporter Math::BigFloat);
-%EXPORT_TAGS = ( 'all' => [ qw(
-) ] );
-
-@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-@EXPORT = qw(
-);
$VERSION = 0.01;
# Globals
diff --git a/lib/Math/BigInt/t/Math/BigInt/Subclass.pm b/lib/Math/BigInt/t/Math/BigInt/Subclass.pm
new file mode 100644
index 0000000000..79a4957d5b
--- /dev/null
+++ b/lib/Math/BigInt/t/Math/BigInt/Subclass.pm
@@ -0,0 +1,56 @@
+#!/usr/bin/perl -w
+
+package Math::BigInt::Subclass;
+
+require 5.005_02;
+use strict;
+
+use Exporter;
+use Math::BigInt(1.45);
+use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK
+ $accuracy $precision $round_mode $div_scale);
+
+@ISA = qw(Exporter Math::BigInt);
+@EXPORT_OK = qw(bgcd);
+
+$VERSION = 0.01;
+
+# Globals
+$accuracy = $precision = undef;
+$round_mode = 'even';
+$div_scale = 40;
+
+sub new
+{
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $value = shift; # no || 0 here!
+ my $decimal = shift;
+ my $radix = 0;
+
+ # Store the floating point value
+ my $self = bless Math::BigInt->new($value), $class;
+ $self->{'_custom'} = 1; # make sure this never goes away
+ return $self;
+}
+
+sub bgcd
+ {
+ Math::BigInt::bgcd(@_);
+ }
+
+sub blcm
+ {
+ Math::BigInt::blcm(@_);
+ }
+
+sub import
+ {
+ my $self = shift;
+# Math::BigInt->import(@_);
+ $self->SUPER::import(@_); # need it for subclasses
+ #$self->export_to_level(1,$self,@_); # need this ?
+ }
+
+1;
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index dd85adc04d..d02caa69e6 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -6,11 +6,11 @@ use strict;
BEGIN
{
$| = 1;
- unshift @INC, '../../lib'; # for running manually
+ unshift @INC, '../lib'; # for running manually
my $location = $0; $location =~ s/bigfltpm.t//;
unshift @INC, $location; # to locate the testing files
# chdir 't' if -d 't';
- plan tests => 1273;
+ plan tests => 1277;
}
use Math::BigInt;
diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t
index 4559d43c3c..be1dc46a97 100644
--- a/lib/Math/BigInt/t/calling.t
+++ b/lib/Math/BigInt/t/calling.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
-# test calling conventions
+# test calling conventions, and :constant overloading
use strict;
use Test;
@@ -10,7 +10,7 @@ BEGIN
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 100;
+ plan tests => 141;
}
package Math::BigInt::Test;
@@ -33,6 +33,7 @@ use Math::BigInt;
use Math::BigFloat;
my ($x,$y,$z,$u);
+my $version = '1.45'; # adjust manually to match latest release
###############################################################################
# check whether op's accept normal strings, even when inherited by subclasses
@@ -55,7 +56,10 @@ while (<DATA>)
foreach $class (qw/
Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
{
- $try = "$class\->$func('$args[0]');";
+ $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 !ok ($rc, $ans);
}
@@ -63,6 +67,43 @@ while (<DATA>)
}
+$class = 'Math::BigInt';
+
+# test whether use Math::BigInt qw/version/ works
+$try = "use $class ($version.'1');";
+$try .= ' $x = $class->new(123); $x = "$x";';
+eval $try;
+ok_undef ( $_ ); # should result in error!
+
+# test whether fallback to calc works
+$try = "use $class ($version,'lib','foo, bar , ');";
+$try .= "$class\->_core_lib();";
+$ans = eval $try;
+ok ( $ans, "Math::BigInt::Calc");
+
+# 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;
+ok ( $ans, "1427247692705959881058285969449495136382746624");
+
+# test wether 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; ok ( $ans, "1024");
+$try = "use $class ($version,'LiB','$class\::Scalar');";
+$try .= ' $x = 2**10; $x = "$x";';
+$ans = eval $try; ok ( $ans, "1024");
+
+# test wether calc => undef (array element not existing) works
+# no longer supported
+#$try = "use $class ($version,'LIB');";
+#$try = "require $class; $class\::import($version,'CALC');";
+#$try .= " \$x = $class\->new(2)**10; \$x = ".'"$x";';
+#print "$try\n";
+#$ans = eval $try; ok ( $ans, 1024);
+
# all done
###############################################################################
@@ -99,8 +140,8 @@ inf:1
5:5
10:10
abc:NaN
-+inf:inf
--inf:-inf
+'+inf':inf
+'-inf':-inf
&bsstr
1:1e+0
0:0e+1
@@ -112,3 +153,16 @@ abc:NaN
&bnot
-2:1
1:-2
+&bzero
+:0
+&bnan
+:NaN
+abc:NaN
+&bone
+:1
+'+':1
+'-':-1
+&binf
+:inf
+'+':inf
+'-':-inf
diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
index e5b6f36a82..c92eaa4618 100644
--- a/lib/Math/BigInt/t/mbimbf.t
+++ b/lib/Math/BigInt/t/mbimbf.t
@@ -3,6 +3,9 @@
# test rounding, accuracy, precicion and fallback, round_mode and mixing
# of classes
+# Make sure you always quote any bare floating-point values, lest 123.46 will
+# be stringified to 123.4599999999 due to limited float prevision.
+
use strict;
use Test;
@@ -11,7 +14,7 @@ BEGIN
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 246;
+ plan tests => 254;
}
# for finding out whether round finds correct class
@@ -74,21 +77,33 @@ my ($x,$y,$z,$u);
ok_undef ($Math::BigInt::accuracy);
ok_undef ($Math::BigInt::precision);
+ok_undef (Math::BigInt::accuracy());
+ok_undef (Math::BigInt::precision());
ok_undef (Math::BigInt->accuracy());
ok_undef (Math::BigInt->precision());
ok ($Math::BigInt::div_scale,40);
ok (Math::BigInt::div_scale(),40);
ok ($Math::BigInt::round_mode,'even');
ok (Math::BigInt::round_mode(),'even');
+ok (Math::BigInt->round_mode(),'even');
ok_undef ($Math::BigFloat::accuracy);
ok_undef ($Math::BigFloat::precision);
-ok_undef (Math::BigFloat->accuracy());
+ok_undef (Math::BigFloat::accuracy());
+ok_undef (Math::BigFloat::accuracy());
+ok_undef (Math::BigFloat->precision());
ok_undef (Math::BigFloat->precision());
ok ($Math::BigFloat::div_scale,40);
ok (Math::BigFloat::div_scale(),40);
ok ($Math::BigFloat::round_mode,'even');
ok (Math::BigFloat::round_mode(),'even');
+ok (Math::BigFloat->round_mode(),'even');
+
+$x = eval 'Math::BigInt->round_mode("huhmbi");';
+ok ($@ =~ /^Unknown round mode huhmbi at/);
+
+$x = eval 'Math::BigFloat->round_mode("huhmbf");';
+ok ($@ =~ /^Unknown round mode huhmbf at/);
# accessors
foreach my $class (qw/Math::BigInt Math::BigFloat/)
@@ -153,7 +168,7 @@ ok ($Math::BigInt::round_mode,'-inf'); # from above
$Math::BigInt::accuracy = undef;
$Math::BigInt::precision = undef;
# local copies
-$x = Math::BigFloat->new(123.456);
+$x = Math::BigFloat->new('123.456');
ok_undef ($x->accuracy());
ok ($x->accuracy(5),5);
ok_undef ($x->accuracy(undef),undef);
@@ -181,35 +196,35 @@ $Math::BigFloat::accuracy = 4;
$Math::BigFloat::precision = -1;
$Math::BigInt::precision = undef;
-ok (Math::BigFloat->new(123.456),123.5); # with A
+ok (Math::BigFloat->new('123.456'),'123.5'); # with A
$Math::BigFloat::accuracy = undef;
-ok (Math::BigFloat->new(123.456),123.5); # with P from MBF, not MBI!
+ok (Math::BigFloat->new('123.456'),'123.5'); # with P from MBF, not MBI!
$Math::BigFloat::precision = undef;
###############################################################################
# see if setting accuracy/precision actually rounds the number
-$x = Math::BigFloat->new(123.456); $x->accuracy(4); ok ($x,123.5);
-$x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46);
+$x = Math::BigFloat->new('123.456'); $x->accuracy(4); ok ($x,'123.5');
+$x = Math::BigFloat->new('123.456'); $x->precision(-2); ok ($x,'123.46');
-$x = Math::BigInt->new(123456); $x->accuracy(4); ok ($x,123500);
-$x = Math::BigInt->new(123456); $x->precision(2); ok ($x,123500);
+$x = Math::BigInt->new('123456'); $x->accuracy(4); ok ($x,123500);
+$x = Math::BigInt->new('123456'); $x->precision(2); ok ($x,123500);
###############################################################################
# test actual rounding via round()
-$x = Math::BigFloat->new(123.456);
-ok ($x->copy()->round(5,2),123.46);
-ok ($x->copy()->round(4,2),123.5);
-ok ($x->copy()->round(undef,-2),123.46);
+$x = Math::BigFloat->new('123.456');
+ok ($x->copy()->round(5,2),'123.46');
+ok ($x->copy()->round(4,2),'123.5');
+ok ($x->copy()->round(undef,-2),'123.46');
ok ($x->copy()->round(undef,2),100);
-$x = Math::BigFloat->new(123.45000);
-ok ($x->copy()->round(undef,-1,'odd'),123.5);
+$x = Math::BigFloat->new('123.45000');
+ok ($x->copy()->round(undef,-1,'odd'),'123.5');
# see if rounding is 'sticky'
-$x = Math::BigFloat->new(123.4567);
+$x = Math::BigFloat->new('123.4567');
$y = $x->copy()->bround(); # no-op since nowhere A or P defined
ok ($y,123.4567);
@@ -221,14 +236,14 @@ ok ($y->precision(),2);
ok_undef ($y->accuracy()); # P has precedence, so A still unset
# see if setting A clears P and vice versa
-$x = Math::BigFloat->new(123.4567);
-ok ($x,123.4567);
+$x = Math::BigFloat->new('123.4567');
+ok ($x,'123.4567');
ok ($x->accuracy(4),4);
ok ($x->precision(-2),-2); # clear A
ok_undef ($x->accuracy());
-$x = Math::BigFloat->new(123.4567);
-ok ($x,123.4567);
+$x = Math::BigFloat->new('123.4567');
+ok ($x,'123.4567');
ok ($x->precision(-2),-2);
ok ($x->accuracy(4),4); # clear P
ok_undef ($x->precision());
@@ -242,18 +257,18 @@ $z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
# These tests are not complete, since they do not excercise every "return"
# statement in the op's. But heh, it's better than nothing...
-$x = Math::BigFloat->new(123.456);
-$y = Math::BigFloat->new(654.321);
+$x = Math::BigFloat->new('123.456');
+$y = Math::BigFloat->new('654.321');
$x->{_a} = 5; # $x->accuracy(5) would round $x straightaway
$y->{_a} = 4; # $y->accuracy(4) would round $x straightaway
-$z = $x + $y; ok ($z,777.8);
-$z = $y - $x; ok ($z,530.9);
-$z = $y * $x; ok ($z,80780);
-$z = $x ** 2; ok ($z,15241);
-$z = $x * $x; ok ($z,15241);
+$z = $x + $y; ok ($z,'777.8');
+$z = $y - $x; ok ($z,'530.9');
+$z = $y * $x; ok ($z,'80780');
+$z = $x ** 2; ok ($z,'15241');
+$z = $x * $x; ok ($z,'15241');
-# not: $z = -$x; ok ($z,-123.46); ok ($x,123.456);
+# not: $z = -$x; ok ($z,'-123.46'); ok ($x,'123.456');
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
$x = Math::BigFloat->new(123456); $x->{_a} = 4;
$z = $x->copy; $z++; ok ($z,123500);
@@ -442,12 +457,12 @@ $x = Math::BigFloat->new(12345); $x->{_a} = 5;
ok ($x->bround(2),'12000');
ok ($x->{_a},2);
-$x = Math::BigFloat->new(1.2345); $x->{_a} = 5;
+$x = Math::BigFloat->new('1.2345'); $x->{_a} = 5;
ok ($x->bround(2),'1.2');
ok ($x->{_a},2);
# mantissa/exponent format and A/P
-$x = Math::BigFloat->new(12345.678); $x->accuracy(4);
+$x = Math::BigFloat->new('12345.678'); $x->accuracy(4);
ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
ok ($x->{_m}->{_f},1); ok ($x->{_e}->{_f},1);
ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
@@ -474,9 +489,9 @@ $x = Math::BigFloat->new(54321); $x->accuracy(4); # '12340'
$y = Math::BigFloat->new(12345); $y->accuracy(3); # '12000'
ok ($x-$y,42000); # 54320+12300=> 42020 => 42000
-$x = Math::BigFloat->new(1.2345); $x->precision(-2); # '1.23'
-$y = Math::BigFloat->new(1.2345); $y->precision(-4); # '1.2345'
-ok ($x+$y,2.46); # 1.2345+1.2300=> 2.4645 => 2.46
+$x = Math::BigFloat->new('1.2345'); $x->precision(-2); # '1.23'
+$y = Math::BigFloat->new('1.2345'); $y->precision(-4); # '1.2345'
+ok ($x+$y,'2.46'); # 1.2345+1.2300=> 2.4645 => 2.46
###############################################################################
# round should find and use proper class
diff --git a/lib/Math/BigInt/t/subclass.t b/lib/Math/BigInt/t/sub_mbf.t
index 332d0c8d16..946222cad3 100644..100755
--- a/lib/Math/BigInt/t/subclass.t
+++ b/lib/Math/BigInt/t/sub_mbf.t
@@ -7,27 +7,26 @@ BEGIN
{
$| = 1;
unshift @INC, '../lib'; # for running manually
- my $location = $0; $location =~ s/subclass.t//;
+ my $location = $0; $location =~ s/sub_mbf.t//;
unshift @INC, $location; # to locate the testing files
- #chdir 't' if -d 't';
- plan tests => 1277;
+ chdir 't' if -d 't';
+ plan tests => 1277 + 4; # + 4 own tests
}
-use Math::BigInt;
-use Math::Subclass;
+use Math::BigFloat::Subclass;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
-$class = "Math::Subclass";
+$class = "Math::BigFloat::Subclass";
require 'bigfltpm.inc'; # perform same tests as bigfltpm
# Now do custom tests for Subclass itself
-my $ms = new Math::Subclass 23;
+my $ms = $class->new(23);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
use Math::BigFloat;
-my $bf = new Math::BigFloat 23; # same as other
+my $bf = Math::BigFloat->new(23); # same as other
$ms += $bf;
print "# Tried: \$ms += \$bf, got $ms" if !ok (46, $ms);
print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t
new file mode 100755
index 0000000000..cb85a02328
--- /dev/null
+++ b/lib/Math/BigInt/t/sub_mbi.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ unshift @INC, '../lib'; # for running manually
+ my $location = $0; $location =~ s/sub_mbi.t//;
+ unshift @INC, $location; # to locate the testing files
+ chdir 't' if -d 't';
+ plan tests => 1608 + 4; # +4 own tests
+ }
+
+use Math::BigInt::Subclass;
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+$class = "Math::BigInt::Subclass";
+
+#my $version = '0.01'; # for $VERSION tests, match current release (by hand!)
+
+require 'bigintpm.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 !ok (1, $ms->{_custom});
+
+use Math::BigInt;
+
+my $bi = Math::BigInt->new(23); # same as other
+$ms += $bi;
+print "# Tried: \$ms += \$bi, got $ms" if !ok (46, $ms);
+print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
+print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));