summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Math/BigFloat.pm92
-rw-r--r--lib/Math/BigInt.pm49
-rw-r--r--lib/Math/BigInt/t/bare_mbf.t4
-rwxr-xr-xlib/Math/BigInt/t/bigfltpm.t8
-rw-r--r--lib/Math/BigInt/t/config.t2
-rw-r--r--lib/Math/BigInt/t/constant.t14
-rw-r--r--lib/Math/BigInt/t/mbi_rand.t8
-rw-r--r--lib/Math/BigInt/t/require.t28
-rw-r--r--lib/Math/BigInt/t/upgrade.t24
-rw-r--r--lib/Math/BigInt/t/use.t29
-rw-r--r--lib/Math/BigInt/t/use_lib1.t22
-rw-r--r--lib/Math/BigInt/t/use_lib2.t23
-rw-r--r--lib/Math/BigInt/t/use_lib3.t23
-rw-r--r--lib/Math/BigInt/t/use_lib4.t23
-rw-r--r--lib/Math/BigInt/t/with_sub.t43
-rw-r--r--lib/Math/BigRat.pm55
-rwxr-xr-xlib/Math/BigRat/t/bigfltrt.t2
-rwxr-xr-xlib/Math/BigRat/t/bigrat.t49
-rwxr-xr-xlib/Math/BigRat/t/bigratpm.t1
-rw-r--r--lib/bigint.pm1
-rw-r--r--lib/bignum.pm4
-rwxr-xr-xlib/bignum/t/bignum.t10
-rwxr-xr-xlib/bignum/t/bigrat.t24
-rwxr-xr-xlib/bignum/t/trace.t39
-rw-r--r--lib/bigrat.pm1
25 files changed, 418 insertions, 160 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index d47b5f1f2a..33cf3d12a3 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -21,7 +21,7 @@ use File::Spec;
use strict;
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
-use vars qw/$upgrade $downgrade $MBI/;
+use vars qw/$upgrade $downgrade/;
my $class = "Math::BigFloat";
use overload
@@ -49,8 +49,8 @@ $div_scale = 40;
$upgrade = undef;
$downgrade = undef;
-$MBI = 'Math::BigInt'; # the package we are using for our private parts
- # changable by use Math::BigFloat with => 'package'
+my $MBI = 'Math::BigInt'; # the package we are using for our private parts
+ # changable by use Math::BigFloat with => 'package'
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
@@ -204,6 +204,24 @@ sub isa
UNIVERSAL::isa($self,$class);
}
+sub config
+ {
+ # return (later set?) configuration data as hash ref
+ my $class = shift || 'Math::BigFloat';
+
+ my $cfg = $MBI->config();
+
+ no strict 'refs';
+ $cfg->{class} = $class;
+ $cfg->{with} = $MBI;
+ foreach (
+ qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
+ {
+ $cfg->{lc($_)} = ${"${class}::$_"};
+ };
+ $cfg;
+ }
+
##############################################################################
# string conversation
@@ -440,6 +458,9 @@ sub badd
return $x;
}
+ return $upgrade->badd($x,$y,$a,$p,$r) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
+
# speed: no add for 0+y or x+0
return $x->bround($a,$p,$r) if $y->is_zero(); # x+0
if ($x->is_zero()) # 0+y
@@ -784,6 +805,9 @@ sub bmul
}
# handle result = 0
return $x->bzero() if $x->is_zero() || $y->is_zero();
+
+ return $upgrade->bmul($x,$y,$a,$p,$r) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
# aEb * cEd = (a*c)E(b+d)
$x->{_m}->bmul($y->{_m});
@@ -1655,52 +1679,78 @@ sub parts
sub import
{
my $self = shift;
- my $l = scalar @_; my $j = 0; my @a = @_;
- my $lib = '';
- for ( my $i = 0; $i < $l ; $i++, $j++)
+ my $l = scalar @_;
+ my $lib = ''; my @a;
+ for ( my $i = 0; $i < $l ; $i++)
{
+# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
if ( $_[$i] eq ':constant' )
{
# this rest causes overlord er load to step in
# print "overload @_\n";
overload::constant float => sub { $self->new(shift); };
- splice @a, $j, 1; $j--;
}
elsif ($_[$i] eq 'upgrade')
{
# this causes upgrading
$upgrade = $_[$i+1]; # or undef to disable
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
}
elsif ($_[$i] eq 'downgrade')
{
# this causes downgrading
$downgrade = $_[$i+1]; # or undef to disable
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
}
elsif ($_[$i] eq 'lib')
{
$lib = $_[$i+1] || ''; # default Calc
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
}
elsif ($_[$i] eq 'with')
{
$MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
+ }
+ else
+ {
+ push @a, $_[$i];
}
}
- my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
- my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
- $file = File::Spec->catdir (@parts, $file);
+# print "mbf @a\n";
+
# let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
my $mbilib = eval { Math::BigInt->config()->{lib} };
- $lib .= ",$mbilib" if defined $mbilib;
- require $file;
- $MBI->import ( lib => $lib, 'objectify' );
+ if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
+ {
+ # MBI already loaded
+ $MBI->import('lib',"$lib,$mbilib", 'objectify');
+ }
+ else
+ {
+ # MBI not loaded, or with ne "Math::BigInt"
+ $lib .= ",$mbilib" if defined $mbilib;
+
+# my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
+# my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
+# $file = File::Spec->catfile (@parts, $file);
+
+ if ($] < 5.006)
+ {
+ # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+ # used in the same script, or eval inside import().
+ my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
+ my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
+ $file = File::Spec->catfile (@parts, $file);
+ eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
+ }
+ else
+ {
+ my $rc = "use $MBI lib => '$lib', 'objectify';";
+ eval $rc;
+ }
+ }
+ die ("Couldn't load $MBI: $! $@") if $@;
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 3c142f2b6a..dd6521e949 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -18,7 +18,7 @@ package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.55';
+$VERSION = '1.56';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
@@ -524,7 +524,6 @@ sub bnan
# otherwise do our own thing
$self->{value} = $CALC->_zero();
}
- $self->{value} = $CALC->_zero();
$self->{sign} = $nan;
delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
return $self;
@@ -903,12 +902,8 @@ sub badd
my ($self,$x,$y,@r) = objectify(2,@_);
return $x if $x->modify('badd');
-# print "mbi badd ",join(' ',caller()),"\n";
-# print "upgrade => ",$upgrade||'undef',
-# " \$x (",ref($x),") \$y (",ref($y),")\n";
return $upgrade->badd($x,$y,@r) if defined $upgrade &&
- ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
-# print "still badd\n";
+ ((!$x->isa($self)) || (!$y->isa($self)));
$r[3] = $y; # no push!
# inf and NaN handling
@@ -969,8 +964,10 @@ sub bsub
my ($self,$x,$y,@r) = objectify(2,@_);
return $x if $x->modify('bsub');
+
+# upgrade done by badd():
# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
-# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
+# ((!$x->isa($self)) || (!$y->isa($self)));
if ($y->is_zero())
{
@@ -1296,7 +1293,7 @@ sub bdiv
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
return $upgrade->bdiv($upgrade->new($x),$y,@r)
- if defined $upgrade && $y->isa($upgrade);
+ if defined $upgrade && !$y->isa($self);
$r[3] = $y; # no push!
@@ -1436,7 +1433,7 @@ sub bpow
return $x if $x->modify('bpow');
return $upgrade->bpow($upgrade->new($x),$y,@r)
- if defined $upgrade && $y->isa($upgrade);
+ if defined $upgrade && !$y->isa($self);
$r[3] = $y; # no push!
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
@@ -1539,7 +1536,7 @@ sub brsft
$bin =~ s/^-0b//; # strip '-0b' prefix
$bin =~ tr/10/01/; # flip bits
# now shift
- if (length($bin) <= $y)
+ if (CORE::length($bin) <= $y)
{
$bin = '0'; # shifting to far right creates -1
# 0, because later increment makes
@@ -2074,7 +2071,6 @@ sub objectify
# currently it tries 'Math::BigInt' + 1, which will not work.
# some shortcut for the common cases
-
# $x->unary_op();
return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
@@ -2092,6 +2088,7 @@ sub objectify
$a[0] = $class;
$a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first?
}
+
no strict 'refs';
# disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
if (defined ${"$a[0]::downgrade"})
@@ -2147,31 +2144,34 @@ sub import
my $self = shift;
$IMPORT++;
- my @a = @_; my $l = scalar @_; my $j = 0;
- for ( my $i = 0; $i < $l ; $i++,$j++ )
+ my @a; my $l = scalar @_;
+ for ( my $i = 0; $i < $l ; $i++ )
{
+# print "at $_[$i]\n";
if ($_[$i] eq ':constant')
{
# this causes overlord er load to step in
overload::constant integer => sub { $self->new(shift) };
overload::constant binary => sub { $self->new(shift) };
- splice @a, $j, 1; $j --;
}
elsif ($_[$i] eq 'upgrade')
{
# this causes upgrading
$upgrade = $_[$i+1]; # or undef to disable
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
}
elsif ($_[$i] =~ /^lib$/i)
{
# this causes a different low lib to take care...
$CALC = $_[$i+1] || '';
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
- splice @a, $j, $s; $j -= $s;
+ $i++;
+ }
+ else
+ {
+ push @a, $_[$i];
}
}
+# print "a @a\n";
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
$self->SUPER::import(@a); # need it for subclasses
@@ -2557,6 +2557,8 @@ Math::BigInt - Arbitrary size integer math package
$x->bsstr(); # normalized string in scientific notation
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
+
+ Math::BigInt->config(); # return hash containing configuration/version
=head1 DESCRIPTION
@@ -2612,6 +2614,15 @@ Each of the methods below accepts three additional parameters. These arguments
$A, $P and $R are accuracy, precision and round_mode. Please see more in the
section about ACCURACY and ROUNDIND.
+=head2 config
+
+ use Data::Dumper;
+
+ print Dumper ( Math::BigInt->config() );
+
+Returns a hash containing the configuration, e.g. the version number, lib
+loaded etc.
+
=head2 accuracy
$x->accuracy(5); # local for $x
diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t
index abeb8c257c..a160c7cf7e 100644
--- a/lib/Math/BigInt/t/bare_mbf.t
+++ b/lib/Math/BigInt/t/bare_mbf.t
@@ -29,10 +29,6 @@ BEGIN
plan tests => 1601;
}
-#use Math::BigInt lib => 'BareCalc';
-#use Math::BigFloat;
-
-# use Math::BigInt; use Math::BigFloat lib => 'BareCalc';
use Math::BigFloat lib => 'BareCalc';
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index a3c0131c15..871365acff 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -26,7 +26,8 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 1601;
+ plan tests => 1601
+ + 2; # own tests
}
use Math::BigInt;
@@ -35,5 +36,8 @@ 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";
-
+
+ok ($class->config()->{class},$class);
+ok ($class->config()->{with},'Math::BigInt');
+
require 'bigfltpm.inc'; # all tests here for sharing
diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t
index db0c27ef80..da574bf362 100644
--- a/lib/Math/BigInt/t/config.t
+++ b/lib/Math/BigInt/t/config.t
@@ -22,7 +22,7 @@ my $cfg = Math::BigInt->config();
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
-ok ($cfg->{lib_version},'0.26');
+ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
ok ($cfg->{class},'Math::BigInt');
ok ($cfg->{upgrade}||'','');
ok ($cfg->{div_scale},40);
diff --git a/lib/Math/BigInt/t/constant.t b/lib/Math/BigInt/t/constant.t
index 3c9b13fd46..bdc73c785e 100644
--- a/lib/Math/BigInt/t/constant.t
+++ b/lib/Math/BigInt/t/constant.t
@@ -16,13 +16,13 @@ use Math::BigInt ':constant';
ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968');
{
- no warnings 'portable';
- # hexadecimal constants
- ok (0x123456789012345678901234567890,
- Math::BigInt->new('0x123456789012345678901234567890'));
- # binary constants
- ok (0b01010100011001010110110001110011010010010110000101101101,
- Math::BigInt->new(
+ no warnings 'portable';
+# hexadecimal constants
+ok (0x123456789012345678901234567890,
+ Math::BigInt->new('0x123456789012345678901234567890'));
+# binary constants
+ok (0b01010100011001010110110001110011010010010110000101101101,
+ Math::BigInt->new(
'0b01010100011001010110110001110011010010010110000101101101'));
}
diff --git a/lib/Math/BigInt/t/mbi_rand.t b/lib/Math/BigInt/t/mbi_rand.t
index 1f19c6b82b..aa020dccab 100644
--- a/lib/Math/BigInt/t/mbi_rand.t
+++ b/lib/Math/BigInt/t/mbi_rand.t
@@ -39,7 +39,7 @@ for (my $i = 0; $i < $count; $i++)
while (length($A) < $la) { $A .= int(rand(100)) x int(rand(16)); }
while (length($B) < $lb) { $B .= int(rand(100)) x int(rand(16)); }
$A = $c->new($A); $B = $c->new($B);
- print "# A $A\n# B $B\n";
+ # print "# A $A\n# B $B\n";
if ($A->is_zero() || $B->is_zero())
{
ok (1,1); ok (1,1); next;
@@ -47,10 +47,12 @@ for (my $i = 0; $i < $count; $i++)
# check that int(A/B)*B + A % B == A holds for all inputs
# $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B);
($ADB,$AMB) = $A->copy()->bdiv($B);
- ok ($A,$ADB*$B+2*$AMB-$AMB);
+ print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n"
+ unless ok ($ADB*$B+2*$AMB-$AMB,$A);
# swap 'em and try this, too
# $X = ($B/$A)*$A + $B % $A;
($ADB,$AMB) = $B->copy()->bdiv($A);
- ok ($B,$ADB*$A+2*$AMB-$AMB);
+ print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n"
+ unless ok ($ADB*$A+2*$AMB-$AMB,$B);
}
diff --git a/lib/Math/BigInt/t/require.t b/lib/Math/BigInt/t/require.t
index de109f1f96..2775a77a6f 100644
--- a/lib/Math/BigInt/t/require.t
+++ b/lib/Math/BigInt/t/require.t
@@ -6,19 +6,33 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
+ # to locate the testing files
+ my $location = $0; $location =~ s/require.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 1;
}
-my ($try,$ans,$x);
+my ($x);
require Math::BigInt; $x = Math::BigInt->new(1); ++$x;
-#$try = 'require Math::BigInt; $x = Math::BigInt->new(1); ++$x;';
-#$ans = eval $try || 'undef';
-#print "# For '$try'\n" if (!ok "$ans" , '2' );
-
ok ($x||'undef',2);
# all tests done
diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t
index 5c8cf5fa66..28d2ce1dac 100644
--- a/lib/Math/BigInt/t/upgrade.t
+++ b/lib/Math/BigInt/t/upgrade.t
@@ -6,10 +6,26 @@ use strict;
BEGIN
{
$| = 1;
- unshift @INC, '../lib'; # for running manually
- my $location = $0; $location =~ s/upgrade.t//;
- unshift @INC, $location; # to locate the testing files
- chdir 't' if -d 't';
+ # to locate the testing files
+ my $location = $0; $location =~ s/upgrade.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 2068
+ 2; # our own tests
}
diff --git a/lib/Math/BigInt/t/use.t b/lib/Math/BigInt/t/use.t
index c52509839d..1f09f5e43c 100644
--- a/lib/Math/BigInt/t/use.t
+++ b/lib/Math/BigInt/t/use.t
@@ -1,8 +1,9 @@
#!/usr/bin/perl -w
-# use Module(); doesn't call impor() - thanx for cpan test David. M. Town and
-# Andreas Marcel Riechert for spotting it. It is fixed by the same code that
-# fixes require Math::BigInt, but we make a test to be sure it really works.
+# 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
+# that fixes require Math::BigInt, but we make a test to be sure it really
+# works.
use strict;
use Test;
@@ -10,8 +11,26 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
+ # to locate the testing files
+ my $location = $0; $location =~ s/use.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 1;
}
diff --git a/lib/Math/BigInt/t/use_lib1.t b/lib/Math/BigInt/t/use_lib1.t
index d737081a57..a6eda82b37 100644
--- a/lib/Math/BigInt/t/use_lib1.t
+++ b/lib/Math/BigInt/t/use_lib1.t
@@ -9,10 +9,26 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
- unshift @INC, 'lib';
+ # to locate the testing files
+ my $location = $0; $location =~ s/use_lib1.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
print "# INC = @INC\n";
+
plan tests => 2;
}
diff --git a/lib/Math/BigInt/t/use_lib2.t b/lib/Math/BigInt/t/use_lib2.t
index 6dd744f298..aa4ba5fbe2 100644
--- a/lib/Math/BigInt/t/use_lib2.t
+++ b/lib/Math/BigInt/t/use_lib2.t
@@ -9,9 +9,26 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
- unshift @INC, 'lib';
+ # to locate the testing files
+ my $location = $0; $location =~ s/use_lib2.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 2;
}
diff --git a/lib/Math/BigInt/t/use_lib3.t b/lib/Math/BigInt/t/use_lib3.t
index 3b43544660..b46b939551 100644
--- a/lib/Math/BigInt/t/use_lib3.t
+++ b/lib/Math/BigInt/t/use_lib3.t
@@ -9,9 +9,26 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
- unshift @INC, 'lib';
+ # to locate the testing files
+ my $location = $0; $location =~ s/use_lib3.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 2;
}
diff --git a/lib/Math/BigInt/t/use_lib4.t b/lib/Math/BigInt/t/use_lib4.t
index 079ba6d05f..bfd85d5f70 100644
--- a/lib/Math/BigInt/t/use_lib4.t
+++ b/lib/Math/BigInt/t/use_lib4.t
@@ -10,9 +10,26 @@ use Test;
BEGIN
{
$| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
- unshift @INC, 'lib';
+ # to locate the testing files
+ my $location = $0; $location =~ s/use_lib4.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, qw(../lib); # to locate the modules
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
plan tests => 2;
}
diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t
new file mode 100644
index 0000000000..07aa3c20f8
--- /dev/null
+++ b/lib/Math/BigInt/t/with_sub.t
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -w
+
+# Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass';
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/with_sub.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, '../lib';
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 1601
+ + 1;
+ }
+
+use Math::BigFloat with => 'Math::BigInt::Subclass';
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
+$class = "Math::BigFloat";
+$CL = "Math::BigInt::Calc";
+
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass');
+
+require 'bigfltpm.inc'; # all tests here for sharing
diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm
index b23408afb2..7330577e66 100644
--- a/lib/Math/BigRat.pm
+++ b/lib/Math/BigRat.pm
@@ -21,7 +21,7 @@ use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
@ISA = qw(Exporter Math::BigFloat);
@EXPORT_OK = qw();
-$VERSION = '0.04';
+$VERSION = '0.05';
use overload; # inherit from Math::BigFloat
@@ -39,6 +39,12 @@ $downgrade = undef;
my $nan = 'NaN';
my $class = 'Math::BigRat';
+sub isa
+ {
+ return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
+ UNIVERSAL::isa(@_);
+ }
+
sub _new_from_float
{
# turn a single float input into a rationale (like '0.1')
@@ -91,13 +97,21 @@ sub new
# print "is ref, but not rat\n";
if ($n->isa('Math::BigFloat'))
{
-# print "is ref, and float\n";
+ # print "is ref, and float\n";
return $self->_new_from_float($n)->bnorm();
}
if ($n->isa('Math::BigInt'))
{
# print "is ref, and int\n";
- $self->{_n} = $n->copy(); # "mantissa" = $d
+ $self->{_n} = $n->copy(); # "mantissa" = $n
+ $self->{_d} = Math::BigInt->bone();
+ $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
+ return $self->bnorm();
+ }
+ if ($n->isa('Math::BigInt::Lite'))
+ {
+# print "is ref, and lite\n";
+ $self->{_n} = Math::BigInt->new($$n); # "mantissa" = $n
$self->{_d} = Math::BigInt->bone();
$self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
return $self->bnorm();
@@ -168,6 +182,8 @@ sub new
$self->bnorm();
}
+###############################################################################
+
sub bstr
{
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
@@ -223,6 +239,9 @@ sub bnorm
# print "$x->{_n} / $x->{_d} => ";
# reduce other numbers
+ # print "bgcd $x->{_n} (",ref($x->{_n}),") $x->{_d} (",ref($x->{_d}),")\n";
+ # disable upgrade in BigInt, otherwise deep recursion
+ local $Math::BigInt::upgrade = undef;
my $gcd = $x->{_n}->bgcd($x->{_d});
if (!$gcd->is_one())
@@ -277,12 +296,10 @@ sub badd
# add two rationales
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
-
- # TODO: upgrade
+ $x = $class->new($x) unless $x->isa($class);
+ $y = $class->new($y) unless $y->isa($class);
-# # upgrade
-# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
+ return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
# 1 1 gcd(3,4) = 1 1*3 + 1*4 7
# - + - = --------- = --
@@ -314,14 +331,12 @@ sub bsub
# subtract two rationales
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ $x = $class->new($x) unless $x->isa($class);
+ $y = $class->new($y) unless $y->isa($class);
+
return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
# TODO: inf handling
- # TODO: upgrade
-
-# # upgrade
-# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
-
# 1 1 gcd(3,4) = 1 1*3 + 1*4 7
# - + - = --------- = --
# 4 3 4*3 12
@@ -352,6 +367,9 @@ sub bmul
# multiply two rationales
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ $x = $class->new($x) unless $x->isa($class);
+ $y = $class->new($y) unless $y->isa($class);
+
return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
# inf handling
@@ -369,11 +387,6 @@ sub bmul
# x== 0 # also: or y == 1 or y == -1
return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
- # TODO: upgrade
-
-# # upgrade
-# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
-
# According to Knuth, this can be optimized by doingtwice gcd (for d and n)
# and reducing in one step)
@@ -395,6 +408,9 @@ sub bdiv
# (BRAT,BRAT) (quo,rem) or BRAT (only rem)
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ $x = $class->new($x) unless $x->isa($class);
+ $y = $class->new($y) unless $y->isa($class);
+
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
@@ -403,9 +419,6 @@ sub bdiv
# TODO: list context, upgrade
-# # upgrade
-# return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
-
# 1 1 1 3
# - / - == - * -
# 4 3 4 1
diff --git a/lib/Math/BigRat/t/bigfltrt.t b/lib/Math/BigRat/t/bigfltrt.t
index 2b049e2d41..a456320e0c 100755
--- a/lib/Math/BigRat/t/bigfltrt.t
+++ b/lib/Math/BigRat/t/bigfltrt.t
@@ -11,7 +11,7 @@ BEGIN
if ($ENV{PERL_CORE})
{
# testing with the core distribution
- @INC = qw(../lib lib);
+ @INC = qw(../t/lib);
}
unshift @INC, '../lib';
if (-d 't')
diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t
index 380f2e794f..9475426c7a 100755
--- a/lib/Math/BigRat/t/bigrat.t
+++ b/lib/Math/BigRat/t/bigrat.t
@@ -8,7 +8,7 @@ BEGIN
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 36;
+ plan tests => 61;
}
# testing of Math::BigRat
@@ -18,6 +18,14 @@ use Math::BigRat;
my ($x,$y,$z);
$x = Math::BigRat->new(1234); ok ($x,1234);
+ok ($x->isa('Math::BigRat'));
+ok (!$x->isa('Math::BigFloat'));
+ok (!$x->isa('Math::BigInt'));
+
+##############################################################################
+# new
+
+$x = Math::BigRat->new(1234); ok ($x,1234);
$x = Math::BigRat->new('1234/1'); ok ($x,1234);
$x = Math::BigRat->new('1234/2'); ok ($x,617);
@@ -34,6 +42,33 @@ $x = Math::BigRat->new('inf'); ok ($x,'inf');
$x = Math::BigRat->new('-inf'); ok ($x,'-inf');
$x = Math::BigRat->new('1/'); ok ($x,'NaN');
+# input ala '1+1/3' isn't parsed ok yet
+$x = Math::BigRat->new('1+1/3'); ok ($x,'NaN');
+
+##############################################################################
+# mixed arguments
+
+ok (Math::BigRat->new('3/7')->badd(1),'10/7');
+ok (Math::BigRat->new('3/10')->badd(1.1),'7/5');
+ok (Math::BigRat->new('3/7')->badd(Math::BigInt->new(1)),'10/7');
+ok (Math::BigRat->new('3/10')->badd(Math::BigFloat->new('1.1')),'7/5');
+
+ok (Math::BigRat->new('3/7')->bsub(1),'-4/7');
+ok (Math::BigRat->new('3/10')->bsub(1.1),'-4/5');
+ok (Math::BigRat->new('3/7')->bsub(Math::BigInt->new(1)),'-4/7');
+ok (Math::BigRat->new('3/10')->bsub(Math::BigFloat->new('1.1')),'-4/5');
+
+ok (Math::BigRat->new('3/7')->bmul(1),'3/7');
+ok (Math::BigRat->new('3/10')->bmul(1.1),'33/100');
+ok (Math::BigRat->new('3/7')->bmul(Math::BigInt->new(1)),'3/7');
+ok (Math::BigRat->new('3/10')->bmul(Math::BigFloat->new('1.1')),'33/100');
+
+ok (Math::BigRat->new('3/7')->bdiv(1),'3/7');
+ok (Math::BigRat->new('3/10')->bdiv(1.1),'3/11');
+ok (Math::BigRat->new('3/7')->bdiv(Math::BigInt->new(1)),'3/7');
+ok (Math::BigRat->new('3/10')->bdiv(Math::BigFloat->new('1.1')),'3/11');
+
+##############################################################################
$x = Math::BigRat->new('1/4'); $y = Math::BigRat->new('1/3');
ok ($x + $y, '7/12');
ok ($x * $y, '1/12');
@@ -70,6 +105,18 @@ ok ($x->bacmp($y),1);
$x = Math::BigRat->new('-124'); $y = Math::BigRat->new('-122');
ok ($x->bcmp($y),-1);
+$x = Math::BigRat->new('3/7'); $y = Math::BigRat->new('5/7');
+ok ($x+$y,'8/7');
+
+$x = Math::BigRat->new('3/7'); $y = Math::BigRat->new('5/7');
+ok ($x*$y,'15/49');
+
+$x = Math::BigRat->new('3/5'); $y = Math::BigRat->new('5/7');
+ok ($x*$y,'3/7');
+
+$x = Math::BigRat->new('3/5'); $y = Math::BigRat->new('5/7');
+ok ($x/$y,'21/25');
+
$x = Math::BigRat->new('-144/9'); $x->bsqrt(); ok ($x,'NaN');
$x = Math::BigRat->new('144/9'); $x->bsqrt(); ok ($x,'4');
diff --git a/lib/Math/BigRat/t/bigratpm.t b/lib/Math/BigRat/t/bigratpm.t
index a4d8ed9070..37c431caa8 100755
--- a/lib/Math/BigRat/t/bigratpm.t
+++ b/lib/Math/BigRat/t/bigratpm.t
@@ -29,7 +29,6 @@ BEGIN
plan tests => 414;
}
-#use Math::BigInt;
use Math::BigRat;
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
diff --git a/lib/bigint.pm b/lib/bigint.pm
index e5770c33a8..900fe18452 100644
--- a/lib/bigint.pm
+++ b/lib/bigint.pm
@@ -145,7 +145,6 @@ sub import
if ($trace)
{
require Math::BigInt::Trace; $class = 'Math::BigInt::Trace';
-# print STDERR "Loading $class";
}
else
{
diff --git a/lib/bignum.pm b/lib/bignum.pm
index a9fd9f0697..c900c95ea2 100644
--- a/lib/bignum.pm
+++ b/lib/bignum.pm
@@ -1,7 +1,7 @@
package bignum;
require 5.005;
-$VERSION = '0.10';
+$VERSION = '0.11';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( );
@@ -123,7 +123,6 @@ sub import
{
require Math::BigInt::Trace; $class = 'Math::BigInt::Trace';
$upgrade = 'Math::BigFloat::Trace';
-# print STDERR "Loading $class";
}
else
{
@@ -148,7 +147,6 @@ sub import
{
require Math::BigFloat::Trace; $class = 'Math::BigFloat::Trace';
$downgrade = 'Math::BigInt::Trace';
-# print STDERR "Loading $class";
}
else
{
diff --git a/lib/bignum/t/bignum.t b/lib/bignum/t/bignum.t
index a804a26f23..32235ea2d5 100755
--- a/lib/bignum/t/bignum.t
+++ b/lib/bignum/t/bignum.t
@@ -10,7 +10,7 @@ BEGIN
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
- plan tests => 17;
+ plan tests => 21;
}
use bignum;
@@ -20,13 +20,15 @@ use bignum;
my $x = 5; ok (ref($x) =~ /^Math::BigInt/); # :constant
-# todo: ok (2 + 2.5,4.5); # should still work
-# todo: $x = 2 + 3.5; ok (ref($x),'Math::BigFloat');
+ok (2 + 2.5,4.5);
+$x = 2 + 3.5; ok (ref($x),'Math::BigFloat');
+ok (2 * 2.1,4.2);
+$x = 2 + 2.1; ok (ref($x),'Math::BigFloat');
$x = 2 ** 255; ok (ref($x) =~ /^Math::BigInt/);
# see if Math::BigInt constant and upgrading works
-ok (Math::BigInt::bsqrt(12),'3.464101615137754587054892683011744733886');
+ok (Math::BigInt::bsqrt('12'),'3.464101615137754587054892683011744733886');
ok (sqrt(12),'3.464101615137754587054892683011744733886');
ok (2/3,"0.6666666666666666666666666666666666666667");
diff --git a/lib/bignum/t/bigrat.t b/lib/bignum/t/bigrat.t
index 3664e8beb6..e5edcb441d 100755
--- a/lib/bignum/t/bigrat.t
+++ b/lib/bignum/t/bigrat.t
@@ -10,7 +10,7 @@ BEGIN
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
- plan tests => 4;
+ plan tests => 16;
}
use bigrat;
@@ -18,16 +18,34 @@ use bigrat;
###############################################################################
# general tests
-my $x = 5; ok (ref($x),'Math::BigInt'); # :constant
+my $x = 5; ok (ref($x) =~ /^Math::BigInt/); # :constant
# todo: ok (2 + 2.5,4.5); # should still work
# todo: $x = 2 + 3.5; ok (ref($x),'Math::BigFloat');
-$x = 2 ** 255; ok (ref($x),'Math::BigInt');
+$x = 2 ** 255; ok (ref($x) =~ /^Math::BigInt/);
# see if Math::BigRat constant works
ok (1/3, '1/3');
ok (1/4+1/3,'7/12');
+ok (5/7+3/7,'8/7');
+
+ok (3/7+1,'10/7');
+ok (3/7+1.1,'107/70');
+ok (3/7+3/7,'6/7');
+
+ok (3/7-1,'-4/7');
+ok (3/7-1.1,'-47/70');
+ok (3/7-2/7,'1/7');
+
+# fails ?
+# ok (1+3/7,'10/7');
+
+ok (1.1+3/7,'107/70');
+ok (3/7*5/7,'15/49');
+ok (3/7 / (5/7),'3/5');
+ok (3/7 / 1,'3/7');
+ok (3/7 / 1.5,'2/7');
###############################################################################
# accurarcy and precision
diff --git a/lib/bignum/t/trace.t b/lib/bignum/t/trace.t
deleted file mode 100755
index 891101b5f9..0000000000
--- a/lib/bignum/t/trace.t
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/usr/bin/perl -w
-
-###############################################################################
-
-use Test;
-use strict;
-
-BEGIN
- {
- $| = 1;
- chdir 't' if -d 't';
- unshift @INC, '../lib';
- plan tests => 1;
- }
-
-BEGIN
- {
- print "# "; # for testsuite
- }
-use bignum qw/ trace /;
-
-###############################################################################
-# general tests
-
-my $x = 5;
-print "\n";
-ok (ref($x),'Math::BigInt::Trace'); # :constant via trace
-
-###############################################################################
-###############################################################################
-# Perl 5.005 does not like ok ($x,undef)
-
-sub ok_undef
- {
- my $x = shift;
-
- ok (1,1) and return if !defined $x;
- ok ($x,'undef');
- }
diff --git a/lib/bigrat.pm b/lib/bigrat.pm
index 3fc0a99060..2c86758e9e 100644
--- a/lib/bigrat.pm
+++ b/lib/bigrat.pm
@@ -107,7 +107,6 @@ sub import
{
require Math::BigInt::Trace; $class = 'Math::BigInt::Trace';
$upgrade = 'Math::BigFloat::Trace';
-# print STDERR "Loading $class";
}
else
{
View Lorry Controller Status