further fixes from John Peacock.
p4raw-id: //depot/perl@12413
lib/CPAN.pm Interface to Comprehensive Perl Archive Network
lib/CPAN/FirstTime.pm Utility for creating CPAN config files
lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions
-lib/CPAN/t/Nox.t See if CPAN::Nox works
lib/CPAN/t/loadme.t See if CPAN the module works
+lib/CPAN/t/Nox.t See if CPAN::Nox works
lib/CPAN/t/vcmp.t See if CPAN the module works
lib/ctime.pl A ctime workalike
lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir)
lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
+lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and subclass.t
lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works
lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works
lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works
+lib/Math/BigInt/t/calling.t Test calling conventions
+lib/Math/BigInt/t/Math/Subclass.pm Empty subclass of BigFloat for test
lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode
+lib/Math/BigInt/t/subclass.t Empty subclass test of BigFloat
lib/Math/Complex.pm A Complex package
lib/Math/Complex.t See if Math::Complex works
lib/Math/Trig.pm A simple interface to complex trigonometry
package Math::BigFloat;
-$VERSION = '1.21';
+$VERSION = '1.23';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
#@EXPORT = qw( );
use strict;
-use vars qw/$AUTOLOAD $accuracy $precision $div_scale $rnd_mode/;
+use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode/;
my $class = "Math::BigFloat";
use overload
# constant for easier life
my $nan = 'NaN';
-# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
-$rnd_mode = 'even';
-$accuracy = undef;
-$precision = undef;
-$div_scale = 40;
+# class constants, use Class->constant_name() to access
+$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+$accuracy = undef;
+$precision = undef;
+$div_scale = 40;
# in case we call SUPER::->foo() and this wants to call modify()
# sub modify () { 0; }
{
- # checks for AUTOLOAD
+ # valid method aliases for AUTOLOAD
my %methods = map { $_ => 1 }
qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
- fabs fneg fint fcmp fzero fnan finc fdec
+ fneg fint facmp fcmp fzero fnan finf finc fdec
+ fceil ffloor
+ /;
+ # valid method's that need to be hand-ed up (for AUTOLOAD)
+ my %hand_ups = map { $_ => 1 }
+ qw / is_nan is_inf is_negative is_positive
+ accuracy precision div_scale round_mode fabs babs
/;
- sub method_valid { return exists $methods{$_[0]||''}; }
+ sub method_alias { return exists $methods{$_[0]||''}; }
+ sub method_hand_up { return exists $hand_ups{$_[0]||''}; }
}
##############################################################################
}
# got string
# handle '+inf', '-inf' first
- if ($wanted =~ /^[+-]inf$/)
+ if ($wanted =~ /^[+-]?inf$/)
{
$self->{_e} = Math::BigInt->new(0);
$self->{_m} = Math::BigInt->new(0);
$self->{sign} = $wanted;
+ $self->{sign} = '+inf' if $self->{sign} eq 'inf';
return $self->bnorm();
}
#print "new string '$wanted'\n";
#print "$wanted => $self->{sign} $self->{value}\n";
$self->bnorm(); # first normalize
# if any of the globals is set, round to them and thus store them insid $self
- $self->round($accuracy,$precision,$rnd_mode)
+ $self->round($accuracy,$precision,$class->round_mode)
if defined $accuracy || defined $precision;
return $self;
}
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to (non-scientific) string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
- my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ #my $x = shift; my $class = ref($x) || $x;
+ #$x = $class->new(shift) unless ref($x);
#die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
#die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
# (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) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ #my $x = shift; my $class = ref($x) || $x;
+ #$x = $class->new(shift) unless ref($x);
#die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
#die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
{
# Make a number from a BigFloat object
# simple return string and let Perl's atoi()/atof() handle the rest
- my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return $x->bsstr();
}
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BFLOAT or num_str, BFLOAT or num_str) return cond_code
my ($self,$x,$y) = objectify(2,@_);
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
-
- # signs are ignored, so check length
- # length(x) is length(m)+e aka length of non-fraction part
- # the longer one is bigger
- my $l = $x->length() - $y->length();
- #print "$l\n";
- return $l if $l != 0;
- #print "equal lengths\n";
-
- # if both are equal long, make full compare
- # first compare only the mantissa
- # if mantissa are equal, compare fractions
+
+ # handle +-inf and NaN's
+ if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]/)
+ {
+ return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if ($x->is_inf() && $y->is_inf());
+ return 1 if ($x->is_inf() && !$y->is_inf());
+ return -1 if (!$x->is_inf() && $y->is_inf());
+ }
+
+ # shortcut
+ my $xz = $x->is_zero();
+ my $yz = $y->is_zero();
+ return 0 if $xz && $yz; # 0 <=> 0
+ return -1 if $xz && !$yz; # 0 <=> +y
+ return 1 if $yz && !$xz; # +x <=> 0
+
+ # adjust so that exponents are equal
+ my $lxm = $x->{_m}->length();
+ my $lym = $y->{_m}->length();
+ my $lx = $lxm + $x->{_e};
+ my $ly = $lym + $y->{_e};
+ # print "x $x y $y lx $lx ly $ly\n";
+ my $l = $lx - $ly; # $l = -$l if $x->{sign} eq '-';
+ # print "$l $x->{sign}\n";
+ return $l <=> 0 if $l != 0;
- return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
+ # lengths (corrected by exponent) are equal
+ # so make mantissa euqal length by padding with zero (shift left)
+ my $diff = $lxm - $lym;
+ my $xm = $x->{_m}; # not yet copy it
+ my $ym = $y->{_m};
+ if ($diff > 0)
+ {
+ $ym = $y->{_m}->copy()->blsft($diff,10);
+ }
+ elsif ($diff < 0)
+ {
+ $xm = $x->{_m}->copy()->blsft(-$diff,10);
+ }
+ my $rc = $xm->bcmp($ym);
+ # $rc = -$rc if $x->{sign} eq '-'; # -124 < -123
+ return $rc <=> 0;
+
+# # signs are ignored, so check length
+# # length(x) is length(m)+e aka length of non-fraction part
+# # the longer one is bigger
+# my $l = $x->length() - $y->length();
+# #print "$l\n";
+# return $l if $l != 0;
+# #print "equal lengths\n";
+#
+# # if both are equal long, make full compare
+# # first compare only the mantissa
+# # if mantissa are equal, compare fractions
+#
+# return $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e};
}
sub badd
sub binc
{
# increment arg by one
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
- $x->badd($self->_one())->round($a,$p,$r);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ $x->badd($self->bone())->round($a,$p,$r);
}
sub bdec
{
# decrement arg by one
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
- $x->badd($self->_one('-'))->round($a,$p,$r);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ $x->badd($self->bone('-'))->round($a,$p,$r);
}
sub blcm
{
- # (BINT or num_str, BINT or num_str) return BINT
+ # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
# does not modify arguments, but returns new object
# Lowest Common Multiplicator
sub bgcd
{
- # (BINT or num_str, BINT or num_str) return BINT
+ # (BFLOAT or num_str, BFLOAT or num_str) return BINT
# does not modify arguments, but returns new object
# GCD -- Euclids algorithm Knuth Vol 2 pg 296
sub is_zero
{
- # return true if arg (BINT or num_str) is zero (array '+', '0')
- my $x = shift; $x = $class->new($x) unless ref $x;
+ # return true if arg (BFLOAT or num_str) is zero (array '+', '0')
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
return 0;
sub is_one
{
- # return true if arg (BINT or num_str) is +1 (array '+', '1')
+ # return true if arg (BFLOAT or num_str) is +1 (array '+', '1')
# or -1 if signis given
- my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
- my $sign = $_[2] || '+';
- return ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ my $sign = shift || ''; $sign = '+' if $sign ne '-';
+ return 1
+ if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
+ return 0;
}
sub is_odd
{
- # return true if arg (BINT or num_str) is odd or false if even
- my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
+ # return true if arg (BFLOAT or num_str) is odd or false if even
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return ($x->{_e}->is_zero() && $x->{_m}->is_odd());
+ return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_odd());
+ return 0;
}
sub is_even
{
# return true if arg (BINT or num_str) is even or false if odd
- my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return 1 if $x->{_m}->is_zero(); # 0e1 is even
- return ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never
+ return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never
+ return 0;
}
sub bmul
# (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
# x / +-inf => 0, reminder x
return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
if $y->{sign} =~ /^[+-]inf$/;
? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
- $y = $class->new($y) if ref($y) ne $class; # promote bigints
+ # promote BigInts and it's subclasses (except when already a BigFloat)
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # old, broken way
+ # $y = $class->new($y) if ref($y) ne $self; # promote bigints
# print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n";
# we need to limit the accuracy to protect against overflow
- my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+
my $fallback = 0;
- if (!defined $scale)
+ my $scale = 0;
+# print "s=$scale a=",$a||'undef'," p=",$p||'undef'," r=",$r||'undef',"\n";
+ my @params = $x->_find_round_parameters($a,$p,$r,$y);
+
+ # no rounding at all, so must use fallback
+ if (scalar @params == 1)
{
# simulate old behaviour
- $scale = $div_scale+1; # one more for proper riund
- $a = $div_scale; # and round to it
- $fallback = 1; # to clear a/p afterwards
+ $scale = $self->div_scale()+1; # at least one more for proper round
+ $params[1] = $self->div_scale(); # and round to it as accuracy
+ $params[3] = $r; # 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[1] || $params[2]) + 4; # take whatever is defined
}
+ # print "s=$scale a=",$params[1]||'undef'," p=",$params[2]||'undef'," f=$fallback\n";
my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
$scale = $lx if $lx > $scale;
$scale = $ly if $ly > $scale;
- #print "scale $scale $lx $ly\n";
+# print "scale $scale $lx $ly\n";
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
# check for / +-1 ( +/- 1E0)
if ($y->is_one())
{
- return wantarray ? ($x,$self->bzero()) : $x;
+ return wantarray ? ($x,$self->bzero()) : $x;
}
+ # calculate the result to $scale digits and then round it
# a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+ #$scale = 82;
#print "self: $self x: $x ref(x) ", ref($x)," m: $x->{_m}\n";
- # my $scale_10 = 10 ** $scale; $x->{_m}->bmul($scale_10);
$x->{_m}->blsft($scale,10);
#print "m: $x->{_m} $y->{_m}\n";
$x->{_m}->bdiv( $y->{_m} ); # a/c
#print "m: $x->{_m}\n";
- #print "e: $x->{_e} $y->{_e}",$scale,"\n";
+ #print "e: $x->{_e} $y->{_e} ",$scale,"\n";
$x->{_e}->bsub($y->{_e}); # b-d
#print "e: $x->{_e}\n";
$x->{_e}->bsub($scale); # correct for 10**scale
#print "after div: m: $x->{_m} e: $x->{_e}\n";
$x->bnorm(); # remove trailing 0's
- #print "after div: m: $x->{_m} e: $x->{_e}\n";
- $x->round($a,$p,$r); # then round accordingly
+ #print "after norm: m: $x->{_m} e: $x->{_e}\n";
+
+ # shortcut to not run trough _find_round_parameters again
+ if (defined $params[1])
+ {
+ $x->bround($params[1],undef,$params[3]); # then round accordingly
+ }
+ else
+ {
+ $x->bfround($params[2],$params[3]); # then round accordingly
+ }
if ($fallback)
{
# clear a/p after round, since user did not request it
- $x->{_a} = undef;
- $x->{_p} = undef;
+ $x->{_a} = undef; $x->{_p} = undef;
}
if (wantarray)
{
my $rem = $x->copy();
- $rem->bmod($y,$a,$p,$r);
+ $rem->bmod($y,$params[1],$params[2],$params[3]);
if ($fallback)
{
# clear a/p after round, since user did not request it
- $x->{_a} = undef;
- $x->{_p} = undef;
+ $rem->{_a} = undef; $rem->{_p} = undef;
}
return ($x,$rem);
}
{
# calculate square root; this should probably
# use a different test to see whether the accuracy we want is...
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN
return $x if $x->{sign} eq '+inf'; # +inf
return $x if $x->is_zero() || $x == 1;
- # we need to limit the accuracy to protect against overflow
- my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+ # we need to limit the accuracy to protect against overflow (ignore $p)
+ my ($scale) = $x->_scale_a($self->accuracy(),$self->round_mode,$a,$r);
my $fallback = 0;
if (!defined $scale)
{
# simulate old behaviour
- $scale = $div_scale+1; # one more for proper riund
- $a = $div_scale; # and round to it
- $fallback = 1; # to clear a/p afterwards
+ $scale = $self->div_scale()+1; # one more for proper riund
+ $a = $self->div_scale(); # and round to it
+ $fallback = 1; # to clear a/p afterwards
}
my $lx = $x->{_m}->length();
$scale = $lx if $scale < $lx;
$lx = 1 if $lx < 1;
my $gs = Math::BigFloat->new('1'. ('0' x $lx));
- # print "first guess: $gs (x $x) scale $scale\n";
+# print "first guess: $gs (x $x) scale $scale\n";
my $diff = $e;
my $y = $x->copy();
my $two = Math::BigFloat->new(2);
- $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts
+ # promote BigInts and it's subclasses (except when already a BigFloat)
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+ # old, broken way
+ # $x = Math::BigFloat->new($x) if ref($x) ne $class; # promote BigInts
+ my $rem;
# $scale = 2;
while ($diff >= $e)
{
return $x->bnan() if $gs->is_zero();
- $r = $y->copy(); $r->bdiv($gs,$scale);
- $x = ($r + $gs);
- $x->bdiv($two,$scale);
+ $rem = $y->copy(); $rem->bdiv($gs,$scale);
+ #print "y $y gs $gs ($gs->{_a}) rem (y/gs)\n $rem\n";
+ $x = ($rem + $gs);
+ #print "x $x rem $rem gs $gs gsa: $gs->{_a}\n";
+ $x->bdiv($two,$scale);
+ #print "x $x (/2)\n";
$diff = $x->copy()->bsub($gs)->babs();
$gs = $x->copy();
}
+# print "before $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
$x->round($a,$p,$r);
+# print "after $x $x->{_a} ",$a||'a undef'," ",$p||'p undef',"\n";
if ($fallback)
{
# clear a/p after round, since user did not request it
- $x->{_a} = undef;
- $x->{_p} = undef;
+ $x->{_a} = undef; $x->{_p} = undef;
}
$x;
}
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
return $x->bone() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
- my $y1 = $y->as_number(); # make bigint
+ my $y1 = $y->as_number(); # make bigint (trunc)
if ($x == -1)
{
# if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 means round to integer
# expects and returns normalized numbers!
- my $x = shift; $x = $class->new($x) unless ref $x;
+ my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
return $x if $x->modify('bfround');
- my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
+ my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
return $x if !defined $scale; # no-op
# never round a 0, +-inf, NaN
return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
# print "MBF bfround $x to scale $scale mode $mode\n";
+ # don't round if x already has lower precision
+ return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
+
+ $x->{_p} = $scale; # remember round in any case
+ $x->{_a} = undef; # and clear A
if ($scale < 0)
{
# print "bfround scale $scale e $x->{_e}\n";
my $dad = -$x->{_e}; # digits after dot
my $zad = 0; # zeros after dot
$zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style
- # print "scale $scale dad $dad zad $zad len $len\n";
+ #print "scale $scale dad $dad zad $zad len $len\n";
# number bsstr len zad dad
# 0.123 123e-3 3 0 3
# do not round after/right of the $dad
return $x if $scale > $dad; # 0.123, scale >= 3 => exit
- # round to zero if rounding inside the $zad, but not for last zero like:
- # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
- if ($scale < $zad)
- {
- return $x->bzero();
- }
- if ($scale == $zad) # for 0.006, scale -2 and trunc
+ # round to zero if rounding inside the $zad, but not for last zero like:
+ # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
+ return $x->bzero() if $scale < $zad;
+ if ($scale == $zad) # for 0.006, scale -3 and trunc
{
- $scale = -$len;
+ $scale = -$len-1;
}
else
{
# calculate digits before dot
my $dbt = $x->{_m}->length(); $dbt += $x->{_e} if $x->{_e}->sign() eq '-';
- if (($scale > $dbt) && ($dbt < 0))
- {
- # if not enough digits before dot, round to zero
- return $x->bzero();
- }
- if (($scale >= 0) && ($dbt == 0))
+ # if not enough digits before dot, round to zero
+ return $x->bzero() if ($scale > $dbt) && ($dbt < 0);
+ # scale always >= 0 here
+ if ($dbt == 0)
{
# 0.49->bfround(1): scale == 1, dbt == 0: => 0.0
# 0.51->bfround(0): scale == 0, dbt == 0: => 1.0
sub bround
{
# accuracy: preserve $N digits, and overwrite the rest with 0's
- my $x = shift; $x = $class->new($x) unless ref $x;
- my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_);
- return $x if !defined $scale; # no-op
+ my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
+
+ die ('bround() needs positive accuracy') if ($_[0] || 0) < 0;
+ my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
+ return $x if !defined $scale; # no-op
+
return $x if $x->modify('bround');
+
+ # scale is now either $x->{_a}, $accuracy, or the user parameter
+ # test whether $x already has lower accuracy, do nothing in this case
+ # but do round if the accuracy is the same, since a math operation might
+ # want to round a number with A=5 to 5 digits afterwards again
+ return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0];
# print "bround $scale $mode\n";
# 0 => return all digits, scale < 0 makes no sense
# subtract the delta from scale, to simulate keeping the zeros
# -5 +5 => 1; -10 +5 => -4
my $delta = $x->{_e} + $x->{_m}->length() + 1;
- # removed by tlr, since causes problems with fraction tests:
- # $scale += $delta if $delta < 0;
# if we should keep more digits than the mantissa has, do nothing
return $x if $x->{_m}->length() <= $scale;
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode); # round mantissa
$x->{_m}->{sign} = '+'; # fix sign back
+ $x->{_a} = $scale; # remember rounding
+ $x->{_p} = undef; # and clear P
$x->bnorm(); # del trailing zeros gen. by bround()
}
sub bfloor
{
# return integer less or equal then $x
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bfloor');
sub bceil
{
# return integer greater or equal then $x
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bceil');
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
sub DESTROY
{
- # going trough AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
+ # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
}
sub AUTOLOAD
$name =~ s/.*:://; # split package
#print "$name\n";
- if (!method_valid($name))
+ no strict 'refs';
+ if (!method_alias($name))
{
- #no strict 'refs';
- ## try one level up
- #&{$class."::SUPER->$name"}(@_);
- # delayed load of Carp and avoid recursion
- require Carp;
- Carp::croak ("Can't call $class\-\>$name, not a valid method");
+ if (!defined $name)
+ {
+ # delayed load of Carp and avoid recursion
+ require Carp;
+ Carp::croak ("Can't call a method without name");
+ }
+ # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
+ if (!method_hand_up($name))
+ {
+ # delayed load of Carp and avoid recursion
+ require Carp;
+ Carp::croak ("Can't call $class\-\>$name, not a valid method");
+ }
+ # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
+ $name =~ s/^f/b/;
+ return &{'Math::BigInt'."::$name"}(@_);
}
- no strict 'refs';
my $bname = $name; $bname =~ s/^f/b/;
*{$class."\:\:$name"} = \&$bname;
&$bname; # uses @_
sub exponent
{
# return a copy of the exponent
- my $self = shift;
- $self = $class->new($self) unless ref $self;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return bnan() if $self->is_nan();
- return $self->{_e}->copy();
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ my $s = $x->{sign}; $s =~ s/^[+-]//;
+ return $self->new($s); # -inf, +inf => +inf
+ }
+ return $x->{_e}->copy();
}
sub mantissa
{
# return a copy of the mantissa
- my $self = shift;
- $self = $class->new($self) unless ref $self;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return bnan() if $self->is_nan();
- my $m = $self->{_m}->copy(); # faster than going via bstr()
- $m->bneg() if $self->{sign} eq '-';
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ my $s = $x->{sign}; $s =~ s/^[+]//;
+ return $self->new($s); # -inf, +inf => +inf
+ }
+ my $m = $x->{_m}->copy(); # faster than going via bstr()
+ $m->bneg() if $x->{sign} eq '-';
return $m;
}
sub parts
{
# return a copy of both the exponent and the mantissa
- my $self = shift;
- $self = $class->new($self) unless ref $self;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return (bnan(),bnan()) if $self->is_nan();
- my $m = $self->{_m}->copy(); # faster than going via bstr()
- $m->bneg() if $self->{sign} eq '-';
- return ($m,$self->{_e}->copy());
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
+ return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
+ }
+ my $m = $x->{_m}->copy(); # faster than going via bstr()
+ $m->bneg() if $x->{sign} eq '-';
+ return ($m,$x->{_e}->copy());
}
##############################################################################
# private stuff (internal use only)
-sub _one
- {
- # internal speedup, set argument to 1, or create a +/- 1
- my $self = shift; $self = ref($self) if ref($self);
- my $x = {}; bless $x, $self;
- $x->{_m} = Math::BigInt->new(1);
- $x->{_e} = Math::BigInt->new(0);
- $x->{sign} = shift || '+';
- return $x;
- }
-
sub import
{
my $self = shift;
- #print "import $self\n";
for ( my $i = 0; $i < @_ ; $i++ )
{
if ( $_[$i] eq ':constant' )
{
# adjust m and e so that m is smallest possible
# round number according to accuracy and precision settings
- my $x = shift;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
{
$x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
}
- # for something like 0Ey, set y to 1
- $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
+ # for something like 0Ey, set y to 1, and -0 => +0
+ $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
+ # this is to prevent automatically rounding when MBI's globals are set
$x->{_m}->{_f} = MB_NEVER_ROUND;
$x->{_e}->{_f} = MB_NEVER_ROUND;
+ # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
+ $x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef;
+ $x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef;
return $x; # MBI bnorm is no-op
}
sub as_number
{
# return a bigint representation of this BigFloat number
- my ($self,$x) = objectify(1,@_);
+ my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x);
my $z;
if ($x->{_e}->is_zero())
sub length
{
- my $x = shift; $x = $class->new($x) unless ref $x;
+ my $x = shift;
+ my $class = ref($x) || $x;
+ $x = $class->new(shift) unless ref($x);
+ return 1 if $x->{_m}->is_zero();
my $len = $x->{_m}->length();
$len += $x->{_e} if $x->{_e}->sign() eq '+';
if (wantarray())
the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
The default rounding mode is 'even'. By using
-C<< Math::BigFloat::round_mode($rnd_mode); >> you can get and set the default
-mode for subsequent rounding. The usage of C<$Math::BigFloat::$rnd_mode> is
+C<< Math::BigFloat::round_mode($round_mode); >> you can get and set the default
+mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
no longer supported.
The second parameter to the round functions then overrides the default
temporarily.
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.42';
+$VERSION = '1.44';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
objectify _swap
);
#@EXPORT = qw( );
-use vars qw/$rnd_mode $accuracy $precision $div_scale/;
+use vars qw/$round_mode $accuracy $precision $div_scale/;
use strict;
# Inside overload, the first arg is always an object. If the original code had
my $CALC = 'Math::BigInt::Calc'; # module to do low level math
sub _core_lib () { return $CALC; } # for test suite
-# Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
-$rnd_mode = 'even';
-$accuracy = undef;
-$precision = undef;
-$div_scale = 40;
+$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+$accuracy = undef;
+$precision = undef;
+$div_scale = 40;
sub round_mode
{
+ no strict 'refs';
# make Class->round_mode() work
- my $self = shift || $class;
- # shift @_ if defined $_[0] && $_[0] eq $class;
+ my $self = shift;
+ my $class = ref($self) || $self || __PACKAGE__;
if (defined $_[0])
{
my $m = shift;
die "Unknown round mode $m"
if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
- $rnd_mode = $m; return;
+ ${"${class}::round_mode"} = $m; return $m;
}
- return $rnd_mode;
+ return ${"${class}::round_mode"};
+ }
+
+sub div_scale
+ {
+ no strict 'refs';
+ # make Class->round_mode() work
+ my $self = shift;
+ my $class = ref($self) || $self || __PACKAGE__;
+ if (defined $_[0])
+ {
+ die ('div_scale must be greater than zero') if $_[0] < 0;
+ ${"${class}::div_scale"} = shift;
+ }
+ return ${"${class}::div_scale"};
}
sub accuracy
{
- # $x->accuracy($a); ref($x) a
- # $x->accuracy(); ref($x);
- # Class::accuracy(); # not supported
- #print "MBI @_ ($class)\n";
- my $x = shift;
+ # $x->accuracy($a); ref($x) $a
+ # $x->accuracy(); ref($x)
+ # Class->accuracy(); class
+ # Class->accuracy($a); class $a
- die ("accuracy() needs reference to object as first parameter.")
- if !ref $x;
+ my $x = shift;
+ my $class = ref($x) || $x || __PACKAGE__;
+ no strict 'refs';
+ # need to set new value?
if (@_ > 0)
{
- $x->{_a} = shift;
- $x->round() if defined $x->{_a};
+ my $a = shift;
+ die ('accuracy must not be zero') if defined $a && $a == 0;
+ if (ref($x))
+ {
+ # $object->accuracy() or fallback to global
+ $x->bround($a) if defined $a;
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ $x->{_p} = undef; # clear P
+ }
+ else
+ {
+ # set global
+ ${"${class}::accuracy"} = $a;
+ }
+ return $a; # shortcut
+ }
+
+ if (ref($x))
+ {
+ # $object->accuracy() or fallback to global
+ return $x->{_a} || ${"${class}::accuracy"};
}
- return $x->{_a};
+ return ${"${class}::accuracy"};
}
sub precision
{
- my $x = shift;
+ # $x->precision($p); ref($x) $p
+ # $x->precision(); ref($x)
+ # Class->precision(); class
+ # Class->precision($p); class $p
- die ("precision() needs reference to object as first parameter.")
- if !ref $x;
+ my $x = shift;
+ my $class = ref($x) || $x || __PACKAGE__;
+ no strict 'refs';
+ # need to set new value?
if (@_ > 0)
{
- $x->{_p} = shift;
- $x->round() if defined $x->{_p};
+ my $p = shift;
+ if (ref($x))
+ {
+ # $object->precision() or fallback to global
+ $x->bfround($p) if defined $p;
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ $x->{_a} = undef; # clear P
+ }
+ else
+ {
+ # set global
+ ${"${class}::precision"} = $p;
+ }
+ return $p; # shortcut
}
- return $x->{_p};
+
+ if (ref($x))
+ {
+ # $object->precision() or fallback to global
+ return $x->{_p} || ${"${class}::precision"};
+ }
+ return ${"${class}::precision"};
}
sub _scale_a
my $self = {}; bless $self, $class;
# handle '+inf', '-inf' first
- if ($wanted =~ /^[+-]inf$/)
+ if ($wanted =~ /^[+-]?inf$/)
{
$self->{value} = $CALC->_zero();
- $self->{sign} = $wanted;
+ $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf';
return $self;
}
# split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
$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,$rnd_mode)
+ $self->round($accuracy,$precision,$round_mode)
if defined $accuracy || defined $precision;
return $self;
}
# (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) = objectify(1,@_);
+# 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,@_);
if ($x->{sign} !~ /^[+-]$/)
{
sub bstr
{
# make a string from bigint object
- my $x = shift; $x = $class->new($x) unless ref $x;
+ 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} !~ /^[+-]$/)
{
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
sub sign
{
# return the sign of the number: +/-/NaN
- my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
return $x->{sign};
}
-sub round
+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.
my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops)
$self = new($self) unless ref($self); # if not object, make one
- my $c = ref($args[0]); # find out class of argument
+ my $c = ref($self); # find out class of argument(s)
unshift @args,$self; # add 'first' argument
# leave bigfloat parts alone
- return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+ return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
no strict 'refs';
- my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
- if (!defined $aa)
- {
- $z = "$c\::precision"; $ap = $$z;
- }
# now pick $a or $p, but only if we have got "arguments"
if ((!defined $a) && (!defined $p) && (@args > 0))
{
foreach (@args)
{
- # take the defined one, or if both defined, the one that is smaller
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p);
+ # 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 none defined, use globals (#2)
if (!defined $p)
{
- $a = $aa; $p = $ap; # save the check: if !defined $a;
+ my $z = "$c\::accuracy"; my $a = $$z;
+ if (!defined $a)
+ {
+ $z = "$c\::precision"; $p = $$z;
+ }
}
} # endif !$a
} # endif !$a || !$P && args > 0
- # for clearity, this is not merged at place (#2)
+ 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)$/;
+ push @params, ($a,$p,$r);
+ }
+ return @params;
+ }
+
+sub round
+ {
+ # round $self according to given parameters, or given second argument's
+ # parameters or global defaults
+ my $self = shift;
+
+ my @params = $self->_find_round_parameters(@_);
+ return $self->bnorm() if @params == 1; # no-op
+
# now round, by calling fround or ffround:
- if (defined $a)
+ if (defined $params[1])
{
- $self->{_a} = $a; $self->bround($a,$r);
+ $self->bround($params[1],$params[3]);
}
- elsif (defined $p)
+ else
{
- $self->{_p} = $p; $self->bfround($p,$r);
+ $self->bfround($params[2],$params[3]);
}
- return $self->bnorm();
+ return $self->bnorm(); # after round, normalize
}
sub bnorm
{
- # (num_str or BINT) return BINT
+ # (numstr or or BINT) return BINT
# Normalize number -- no-op here
+ return Math::BigInt->new($_[0]) if !ref($_[0]);
return $_[0];
}
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
- my $x = shift; $x = $class->new($x) unless ref $x;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
return $x if $x->modify('babs');
# post-normalized abs for internal use (does nothing for NaN)
$x->{sign} =~ s/^-/+/;
{
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my $x = shift; $x = $class->new($x) unless ref $x;
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
return $x if $x->modify('bneg');
# for +0 dont negate (to have always normalized)
return $x if $x->is_zero();
sub binc
{
# increment arg by one
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
- # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('binc');
$x->badd($self->__one())->round($a,$p,$r);
}
sub bdec
{
# decrement arg by one
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bdec');
$x->badd($self->__one('-'))->round($a,$p,$r);
}
{
# (num_str or BINT) return BINT
# represent ~x as twos-complement number
- my ($self,$x) = objectify(1,@_);
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
+
return $x if $x->modify('bnot');
- $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday
- $x;
+ $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday
+ return $x->round($a,$p,$r);
}
sub is_zero
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
- #my ($self,$x) = objectify(1,@_);
- my $x = shift; $x = $class->new($x) unless ref $x;
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
$CALC->_is_zero($x->{value});
- #return $CALC->_is_zero($x->{value});
}
sub is_nan
{
# return true if arg (BINT or num_str) is NaN
- #my ($self,$x) = objectify(1,@_);
- my $x = shift; $x = $class->new($x) unless ref $x;
- return ($x->{sign} eq $nan);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return 1 if $x->{sign} eq $nan;
+ return 0;
}
sub is_inf
{
# return true if arg (BINT or num_str) is +-inf
- #my ($self,$x) = objectify(1,@_);
- my $x = shift; $x = $class->new($x) unless ref $x;
- my $sign = shift || '';
+ my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ $sign = '' if !defined $sign;
+ return 0 if $sign !~ /^([+-]|)$/;
- return $x->{sign} =~ /^[+-]inf$/ if $sign eq '';
- return $x->{sign} =~ /^[$sign]inf$/;
+ if ($sign eq '')
+ {
+ return 1 if ($x->{sign} =~ /^[+-]inf$/);
+ return 0;
+ }
+ $sign = quotemeta($sign.'inf');
+ return 1 if ($x->{sign} =~ /^$sign$/);
+ return 0;
}
sub is_one
{
# return true if arg (BINT or num_str) is +1
# or -1 if sign is given
- #my ($self,$x) = objectify(1,@_);
- my $x = shift; $x = $class->new($x) unless ref $x;
- my $sign = shift || ''; $sign = '+' if $sign ne '-';
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
+
+ $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
- return 0 if $x->{sign} ne $sign;
+ return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
return $CALC->_is_one($x->{value});
}
sub is_odd
{
# return true when arg (BINT or num_str) is odd, false for even
- my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_odd($x->{value});
sub is_even
{
# return true when arg (BINT or num_str) is even, false for odd
- my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_even($x->{value});
sub is_positive
{
# return true when arg (BINT or num_str) is positive (>= 0)
- my $x = shift; $x = $class->new($x) unless ref $x;
- return ($x->{sign} =~ /^\+/);
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return 1 if $x->{sign} =~ /^\+/;
+ return 0;
}
sub is_negative
{
# return true when arg (BINT or num_str) is negative (< 0)
- my $x = shift; $x = $class->new($x) unless ref $x;
- return ($x->{sign} =~ /^-/);
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return 1 if ($x->{sign} =~ /^-/);
+ return 0;
}
###############################################################################
# call div here
my $rem = $self->bzero();
$rem->{sign} = $y->{sign};
- #($x->{value},$rem->{value}) = div($x->{value},$y->{value});
($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
- # do not leave rest "-0";
+ # 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";
$x->round($a,$p,$r,$y);
if (wantarray)
{
sub length
{
- my ($self,$x) = objectify(1,@_);
+ 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
sub bsqrt
{
- my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN
return $x->bzero() if $x->is_zero(); # 0 => 0
sub exponent
{
# return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
- my ($self,$x) = objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return bnan() if $x->is_nan();
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ my $s = $x->{sign}; $s =~ s/^[+-]//;
+ return $self->new($s); # -inf,+inf => inf
+ }
my $e = $class->bzero();
return $e->binc() if $x->is_zero();
$e += $x->_trailing_zeros();
sub mantissa
{
- # return a copy of the mantissa (here always $self)
- my ($self,$x) = objectify(1,@_);
+ # return the mantissa (compatible to Math::BigFloat, e.g. reduced)
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return bnan() if $x->is_nan();
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ my $s = $x->{sign}; $s =~ s/^[+]//;
+ return $self->new($s); # +inf => inf
+ }
my $m = $x->copy();
# that's inefficient
my $zeros = $m->_trailing_zeros();
sub parts
{
- # return a copy of both the exponent and the mantissa (here 0 and self)
- my $self = shift;
- $self = $class->new($self) unless ref $self;
+ # return a copy of both the exponent and the mantissa
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return ($self->mantissa(),$self->exponent());
+ return ($x->mantissa(),$x->exponent());
}
##############################################################################
sub bfround
{
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
- # $n == 0 => round to integer
+ # $n == 0 || $n == 1 => round to integer
my $x = shift; $x = $class->new($x) unless ref $x;
- my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
+ my ($scale,$mode) = $x->_scale_p($precision,$round_mode,@_);
return $x if !defined $scale; # no-op
# no-op for BigInts if $n <= 0
- return $x if $scale <= 0;
+ if ($scale <= 0)
+ {
+ $x->{_p} = $scale; return $x;
+ }
$x->bround( $x->length()-$scale, $mode);
+ $x->{_a} = undef; # bround sets {_a}
+ $x->{_p} = $scale; # so correct it
+ $x;
}
sub _scan_for_nonzero
# 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,$rnd_mode,@_);
+ my ($scale,$mode) = $x->_scale_a($accuracy,$round_mode,@_);
return $x if !defined $scale; # no-op
# print "MBI round: $x to $scale $mode\n";
- # -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
# we have fewer digits than we want to scale to
my $len = $x->length();
- # print "$len $scale\n";
- return $x if $len < abs($scale);
+ # print "$scale $len\n";
+ # scale < 0, but > -len (not >=!)
+ if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
+ {
+ $x->{_a} = $scale if !defined $x->{_a}; # if not yet defined overwrite
+ return $x;
+ }
# count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
my ($pad,$digit_round,$digit_after);
$pad = $len - $scale;
- $pad = abs($scale)+1 if $scale < 0;
+ $pad = abs($scale-1) if $scale < 0;
+
# do not use digit(), it is costly for binary => decimal
#$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len;
#$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0;
+
my $xs = $CALC->_str($x->{value});
my $pl = -$pad-1;
+
+ # print "pad $pad pl $pl scale $scale len $len\n";
# pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
# pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
$digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
$pl++; $pl ++ if $pad >= $len;
$digit_after = '0'; $digit_after = substr($$xs,$pl,1)
if $pad > 0;
-
- #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len;
- #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0;
- # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n";
+
+ # print "$pad $pl $$xs dr $digit_round da $digit_after\n";
# 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
{
$x->bzero(); # round to '0'
}
- # print "res $pad $len $x $$xs\n";
+ # print "res $pad $len $x $$xs\n";
}
# move this later on after the inc of the string
#$x->{value} = $CALC->_new($xs); # put back in
if ($round_up) # what gave test above?
{
+ #print " $pad => ";
$pad = $len if $scale < 0; # tlr: whack 0.51=>1.0
# modify $x in place, undef, undef to avoid rounding
# str creation much faster than 10 ** something
+ #print " $pad, $x => ";
$x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) );
+ #print "$x\n";
# increment string in place, to avoid dec=>hex for the '1000...000'
# $xs ...blah foo
}
# to here:
#$x->{value} = $CALC->_new($xs); # put back in
+
+ $x->{_a} = $scale if $scale >= 0;
+ if ($scale < 0)
+ {
+ $x->{_a} = $len+$scale;
+ $x->{_a} = 0 if $scale < -$len;
+ }
$x;
}
{
# return integer less or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
# not needed: return $x if $x->modify('bfloor');
-
return $x->round($a,$p,$r);
}
{
# return integer greater or equal then number, since it is already integer,
# always returns $self
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
# not needed: return $x if $x->modify('bceil');
-
return $x->round($a,$p,$r);
}
# $class,1,2. (We can not take '1' as class ;o)
# badd($class,1) is not supported (it should, eventually, try to add undef)
# 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]);
+ # $x->binary_op($y);
+ #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2)
+ # && ref($_[1]) && ref($_[2]);
+
+# print "obj '",join ("' '", @_),"'\n";
+
my $count = abs(shift || 0);
#print caller(),"\n";
#print "$count\n";
$count--;
$k = shift;
+ # print "$k (",ref($k),") => \n";
if (!ref($k))
{
$k = $a[0]->new($k);
# foreign object, try to convert to integer
$k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
}
+ # print "$k (",ref($k),")\n";
push @a,$k;
}
push @a,@_; # return other params, too
my $es = ''; my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
- $s .= '0x';
if ($CALC->can('_as_hex'))
{
- $es = $CALC->_as_hex($x->{value});
+ $es = ${$CALC->_as_hex($x->{value})};
}
else
{
}
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
+ $s .= '0x';
}
$s . $es;
}
my $es = ''; my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
- $s .= '0b';
if ($CALC->can('_as_bin'))
{
- $es = $CALC->_as_bin($x->{value});
+ $es = ${$CALC->_as_bin($x->{value})};
}
else
{
}
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
+ $s .= '0b';
}
$s . $es;
}
# latter is always 0 digits long for BigInt's
$x->exponent(); # return exponent as BigInt
- $x->mantissa(); # return mantissa 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_number(); # return as BigInt (in BigInt: same as copy())
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
-
=head1 DESCRIPTION
All operators (inlcuding basic math operations) are overloaded if you
following rounding modes (R):
'even', 'odd', '+inf', '-inf', 'zero', 'trunc'
* you can set and get the global R by using Math::SomeClass->round_mode()
- or by setting $Math::SomeClass::rnd_mode
+ or by setting $Math::SomeClass::round_mode
* after each operation, $result->round() is called, and the result may
eventually be rounded (that is, if A or P were set either locally,
globally or as parameter to the operation)
- * to manually round a number, call $x->round($A,$P,$rnd_mode);
+ * to manually round a number, call $x->round($A,$P,$round_mode);
this will round the number by using the appropriate rounding function
and then normalize it.
* rounding modifies the local settings of the number:
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.10';
+$VERSION = '0.12';
# Package to store unsigned big integers in decimal and do math with them
# - fully remove funky $# stuff (maybe)
# USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
-# instead of "/ 1e5" at some places, (marked with USE_MUL).
+# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
+# BS2000, some Crays need USE_DIV instead.
# The BEGIN block is used to determine which of the two variants gives the
# correct result.
# constants for easier life
my $nan = 'NaN';
-my $BASE_LEN = 7;
-my $BASE = int("1e".$BASE_LEN); # var for trying to change it to 1e7
-my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL);
+
+sub _base_len
+ {
+ my $b = shift;
+ if (defined $b)
+ {
+ $BASE_LEN = $b;
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ $MAX_VAL = $BASE-1;
+ # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL\n";
+ # print "int: ",int($BASE * $RBASE),"\n";
+ 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;
+ }
BEGIN
{
$num = ('9' x ++$e) + 0;
$num *= $num + 1;
} until ($num == $num - 1 or $num - 1 == $num - 2);
- $BASE_LEN = $e-1;
- $BASE = int("1e".$BASE_LEN);
- $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ _base_len($e-1);
}
# for quering and setting, to debug/benchmark things
-sub _base_len
- {
- my $b = shift;
- if (defined $b)
- {
- $BASE_LEN = $b;
- $BASE = int("1e".$BASE_LEN);
- $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
- }
- $BASE_LEN;
- }
##############################################################################
# create objects from various representations
}
}
-sub _mul
+sub _mul_use_mul
{
# (BINT, BINT) return nothing
# multiply two numbers in internal representation
return $xv;
}
-sub _div
+sub _mul_use_div
+ {
+ # (BINT, BINT) return nothing
+ # 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?
+ for $xi (@$xv)
+ {
+ $car = 0; $cty = 0;
+ # looping through this if $xi == 0 is silly - so optimize it away!
+ $xi = (shift @prod || 0), next if $xi == 0;
+ for $yi (@$yv)
+ {
+ $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+ $prod[$cty++] =
+ $prod - ($car = int($prod / $BASE)) * $BASE;
+ }
+ $prod[$cty] += $car if $car; # need really to check for 0?
+ $xi = shift @prod;
+ }
+ push @$xv, @prod;
+ __strip_zeros($xv);
+ # normalize (handled last to save check for $y->is_zero()
+ return $xv;
+ }
+
+sub _div_use_mul
{
# ref to array, ref to array, modify first array and return remainder if
# in list context
$u2 = 0 unless $u2;
#warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
# if $v1 == 0;
- $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+ # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+ $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1));
--$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
if ($q)
{
return $x;
}
+sub _div_use_div
+ {
+ # ref to array, ref to array, modify first array and return remainder if
+ # in list context
+ # no longer handles sign
+ my ($c,$x,$yorg) = @_;
+ my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
+
+ my (@d,$tmp,$q,$u2,$u1,$u0);
+
+ $car = $bar = $prd = 0;
+
+ my $y = [ @$yorg ];
+ if (($dd = int($BASE/($y->[-1]+1))) != 1)
+ {
+ for $xi (@$x)
+ {
+ $xi = $xi * $dd + $car;
+ $xi -= ($car = int($xi / $BASE)) * $BASE;
+ }
+ push(@$x, $car); $car = 0;
+ for $yi (@$y)
+ {
+ $yi = $yi * $dd + $car;
+ $yi -= ($car = int($yi / $BASE)) * $BASE;
+ }
+ }
+ else
+ {
+ push(@$x, 0);
+ }
+ @q = (); ($v2,$v1) = @$y[-2,-1];
+ $v2 = 0 unless $v2;
+ while ($#$x > $#$y)
+ {
+ ($u2,$u1,$u0) = @$x[-3..-1];
+ $u2 = 0 unless $u2;
+ #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
+ # if $v1 == 0;
+ # $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
+ $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1));
+ --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
+ if ($q)
+ {
+ ($car, $bar) = (0,0);
+ for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
+ {
+ $prd = $q * $y->[$yi] + $car;
+ $prd -= ($car = int($prd / $BASE)) * $BASE;
+ $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+ }
+ if ($x->[-1] < $car + $bar)
+ {
+ $car = 0; --$q;
+ for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
+ {
+ $x->[$xi] -= $BASE
+ if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE));
+ }
+ }
+ }
+ pop(@$x); unshift(@q, $q);
+ }
+ if (wantarray)
+ {
+ @d = ();
+ if ($dd != 1)
+ {
+ $car = 0;
+ for $xi (reverse @$x)
+ {
+ $prd = $car * $BASE + $xi;
+ $car = $prd - ($tmp = int($prd / $dd)) * $dd;
+ unshift(@d, $tmp);
+ }
+ }
+ else
+ {
+ @d = @$x;
+ }
+ @$x = @q;
+ __strip_zeros($x);
+ __strip_zeros(\@d);
+ return ($x,\@d);
+ }
+ @$x = @q;
+ __strip_zeros($x);
+ return $x;
+ }
+
##############################################################################
# shifts
=head1 SYNOPSIS
-Provides support for big integer calculations. Not intended
-to be used by other modules. Other modules which export the
-same functions can also be used to support Math::Bigint
+Provides support for big integer calculations. Not intended to be used by other
+modules (except Math::BigInt::Cached). Other modules which sport the same
+functions can also be used to support Math::Bigint, like Math::BigInt::Pari.
=head1 DESCRIPTION
module which follows the same API as this can be used instead by
using the following call:
- use Math::BigInt lib => BigNum;
+ use Math::BigInt lib => 'libname';
=head1 EXPORT
return 0 for ok, otherwise error message as string
The following functions are optional, and can be defined if the underlying lib
-has a fast way to do them. If not defined, Math::BigInt will use a pure, but
+has a fast way to do them. If undefined, Math::BigInt will use a pure, but
slow, Perl way as fallback to emulate these:
_from_hex(str) return ref to new object from ref to hexadecimal string
_from_bin(str) return ref to new object from ref to binary string
+ _as_hex(str) return ref to scalar string containing the value as
+ unsigned hex string, with the '0x' prepended.
+ Leading zeros must be stripped.
+ _as_bin(str) Like as_hex, only as binary string containing only
+ zeros and ones. Leading zeros must be stripped and a
+ '0b' must be prepended.
+
_rsft(obj,N,B) shift object in base B by N 'digits' right
_lsft(obj,N,B) shift object in base B by N 'digits' left
=head1 SEE ALSO
-L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect> and
-L<Math::BigInt::Pari>.
+L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
+L<Math::BigInt::GMP>, L<Math::BigInt::Cached> and L<Math::BigInt::Pari>.
=cut
--- /dev/null
+#!/usr/bin/perl -w
+
+package Math::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
+ $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
+$accuracy = $precision = undef;
+$round_mode = 'even';
+$div_scale = 40;
+
+sub new
+{
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $value = shift || 0; # Set to 0 if not provided
+ my $decimal = shift;
+ my $radix = 0;
+
+ # Store the floating point value
+ my $self = bless Math::BigFloat->new($value), $class;
+ $self->{'_custom'} = 1; # make sure this never goes away
+ return $self;
+}
+
+1;
--- /dev/null
+#include this file into another test for subclass testing...
+while (<DATA>)
+ {
+ chop;
+ $_ =~ s/#.*$//; # remove comments
+ $_ =~ s/\s+$//; # trailing spaces
+ next if /^$/; # skip empty lines & comments
+ if (s/^&//)
+ {
+ $f = $_;
+ }
+ elsif (/^\$/)
+ {
+ $setup = $_; $setup =~ s/\$/\$${class}::/g; # round_mode, div_scale
+ #print "\$setup== $setup\n";
+ }
+ else
+ {
+ if (m|^(.*?):(/.+)$|)
+ {
+ $ans = $2;
+ @args = split(/:/,$1,99);
+ }
+ else
+ {
+ @args = split(/:/,$_,99); $ans = pop(@args);
+ }
+ $try = "\$x = new $class \"$args[0]\";";
+ if ($f eq "fnorm")
+ {
+ $try .= "\$x;";
+ } elsif ($f eq "finf") {
+ $try .= "\$x->finf('$args[1]');";
+ } elsif ($f eq "fnan") {
+ $try .= "\$x->fnan();";
+ } elsif ($f eq "numify") {
+ $try .= "\$x->numify();";
+ } elsif ($f eq "fone") {
+ $try .= "\$x->bone('$args[1]');";
+ } elsif ($f eq "fstr") {
+ $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
+ $try .= '$x->fstr();';
+ } elsif ($f eq "fsstr") {
+ $try .= '$x->fsstr();';
+ } elsif ($f eq "parts") {
+ # ->bstr() to see if a BigFloat is returned
+ $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
+ $try .= '"$a $b";';
+ } elsif ($f eq "length") {
+ $try .= '$x->length();';
+ } elsif ($f eq "exponent") {
+ # ->bstr() to see if a BigFloat is returned
+ $try .= '$x->exponent()->bstr();';
+ } elsif ($f eq "mantissa") {
+ # ->bstr() to see if a BigFloat is returned
+ $try .= '$x->mantissa()->bstr();';
+ } elsif ($f eq "fneg") {
+ $try .= '$x->bneg();';
+ } elsif ($f eq "fnorm") {
+ $try .= '$x->fnorm();';
+ } elsif ($f eq "bfloor") {
+ $try .= '$x->ffloor();';
+ } elsif ($f eq "bceil") {
+ $try .= '$x->fceil();';
+ } elsif ($f eq "is_zero") {
+ $try .= '$x->is_zero();';
+ } elsif ($f eq "is_one") {
+ $try .= '$x->is_one();';
+ } elsif ($f eq "is_positive") {
+ $try .= '$x->is_positive();';
+ } elsif ($f eq "is_negative") {
+ $try .= '$x->is_negative();';
+ } elsif ($f eq "is_odd") {
+ $try .= '$x->is_odd();';
+ } elsif ($f eq "is_even") {
+ $try .= '$x->is_even();';
+ } elsif ($f eq "as_number") {
+ $try .= '$x->as_number();';
+ } elsif ($f eq "fabs") {
+ $try .= '$x->fabs();';
+ } elsif ($f eq "finc") {
+ $try .= '++$x;';
+ } elsif ($f eq "fdec") {
+ $try .= '--$x;';
+ }elsif ($f eq "fround") {
+ $try .= "$setup; \$x->fround($args[1]);";
+ } elsif ($f eq "ffround") {
+ $try .= "$setup; \$x->ffround($args[1]);";
+ } elsif ($f eq "fsqrt") {
+ $try .= "$setup; \$x->fsqrt();";
+ }
+ else
+ {
+ $try .= "\$y = new $class \"$args[1]\";";
+ if ($f eq "fcmp") {
+ $try .= '$x <=> $y;';
+ } elsif ($f eq "facmp") {
+ $try .= '$x->facmp($y);';
+ } elsif ($f eq "fpow") {
+ $try .= '$x ** $y;';
+ } elsif ($f eq "fadd") {
+ $try .= '$x + $y;';
+ } elsif ($f eq "fsub") {
+ $try .= '$x - $y;';
+ } elsif ($f eq "fmul") {
+ $try .= '$x * $y;';
+ } elsif ($f eq "fdiv") {
+ $try .= "$setup; \$x / \$y;";
+ } elsif ($f eq "fmod") {
+ $try .= '$x % $y;';
+ } else { warn "Unknown op '$f'"; }
+ }
+ $ans1 = eval $try;
+ if ($ans =~ m|^/(.*)$|)
+ {
+ my $pat = $1;
+ if ($ans1 =~ /$pat/)
+ {
+ ok (1,1);
+ }
+ else
+ {
+ print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
+ }
+ }
+ else
+ {
+ if ($ans eq "")
+ {
+ ok_undef ($ans1);
+ }
+ else
+ {
+ print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+ if (ref($ans1) eq "$class")
+ {
+ #print $ans1->_trailing_zeros(),"\n";
+ print "# Has trailing zeros after '$try'\n"
+ if !ok ($ans1->{_m}->_trailing_zeros(), 0);
+ }
+ }
+ } # end pattern or string
+ }
+ } # end while
+
+# check whether new() for BigInts destroys them ($y == 12 in this case)
+$x = Math::BigInt->new(1200); $y = $class->new($x);
+ok ($y,1200); ok ($x,1200);
+
+###############################################################################
+# fdiv() in list context
+$x = $class->bzero(); ($x,$y) = $x->fdiv(0);
+ok ($x,'NaN'); ok ($y,'NaN');
+
+# fdiv() in list context
+$x = $class->bzero(); ($x,$y) = $x->fdiv(1);
+ok ($x,0); ok ($y,0);
+
+# all done
+
+###############################################################################
+# 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');
+ }
+
+__DATA__
+&fnorm
+1:1
+-0:0
+fnormNaN:NaN
++inf:inf
+-inf:-inf
+123:123
+-123.4567:-123.4567
+&as_number
+0:0
+1:1
+1.2:1
+2.345:2
+-2:-2
+-123.456:-123
+-200:-200
+&finf
+1:+:inf
+2:-:-inf
+3:abc:inf
+&numify
+0:0e+1
++1:1e+0
+1234:1234e+0
+NaN:NaN
++inf:inf
+-inf:-inf
+&fnan
+abc:NaN
+2:NaN
+-2:NaN
+0:NaN
+&fone
+2:+:1
+-2:-:-1
+-2:+:1
+2:-:-1
+0::1
+-2::1
+abc::1
+2:abc:1
+&fsstr
++inf:inf
+-inf:-inf
+abcfsstr:NaN
+1234.567:1234567e-3
+&fstr
++inf:::inf
+-inf:::-inf
+abcfstr:::NaN
+1234.567:9::1234.56700
+1234.567::-6:1234.567000
+12345:5::12345
+0.001234:6::0.00123400
+0.001234::-8:0.00123400
+0:4::0
+0::-4:0.0000
+&fnorm
+inf:inf
++inf:inf
+-inf:-inf
++infinity:NaN
++-inf:NaN
+abc:NaN
+ 1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:0
++0:0
++00:0
++0_0_0:0
+000000_0000000_00000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+123.456a:NaN
+123.456:123.456
+0.01:0.01
+.002:0.002
++.2:0.2
+-0.0003:-0.0003
+-.0000000004:-0.0000000004
+123456E2:12345600
+123456E-2:1234.56
+-123456E2:-12345600
+-123456E-2:-1234.56
+1e1:10
+2e-11:0.00000000002
+# excercise _split
+ .02e-1:0.002
+ 000001:1
+ -00001:-1
+ -1:-1
+ 000.01:0.01
+ -000.0023:-0.0023
+ 1.1e1:11
+-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
+&fpow
+2:2:4
+1:2:1
+1:3:1
+-1:2:1
+-1:3:-1
+123.456:2:15241.383936
+2:-2:0.25
+2:-3:0.125
+128:-2:0.00006103515625
+abc:123.456:NaN
+123.456:abc:NaN
++inf:123.45:inf
+-inf:123.45:-inf
++inf:-123.45:inf
+-inf:-123.45:-inf
+&fneg
+fnegNaN:NaN
++inf:-inf
+-inf:inf
++0:0
++1:-1
+-1:1
++123456789:-123456789
+-123456789:123456789
++123.456789:-123.456789
+-123456.789:123456.789
+&fabs
+fabsNaN:NaN
++inf:inf
+-inf:inf
++0:0
++1:1
+-1:1
++123456789:123456789
+-123456789:123456789
++123.456789:123.456789
+-123456.789:123456.789
+&fround
+$round_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNfround:5:NaN
++10123456789:5:10123000000
+-10123456789:5:-10123000000
++10123456789.123:5:10123000000
+-10123456789.123:5:-10123000000
++10123456789:9:10123456700
+-10123456789:9:-10123456700
++101234500:6:101234000
+-101234500:6:-101234000
+$round_mode = "zero"
++20123456789:5:20123000000
+-20123456789:5:-20123000000
++20123456789.123:5:20123000000
+-20123456789.123:5:-20123000000
++20123456789:9:20123456800
+-20123456789:9:-20123456800
++201234500:6:201234000
+-201234500:6:-201234000
+$round_mode = "+inf"
++30123456789:5:30123000000
+-30123456789:5:-30123000000
++30123456789.123:5:30123000000
+-30123456789.123:5:-30123000000
++30123456789:9:30123456800
+-30123456789:9:-30123456800
++301234500:6:301235000
+-301234500:6:-301234000
+$round_mode = "-inf"
++40123456789:5:40123000000
+-40123456789:5:-40123000000
++40123456789.123:5:40123000000
+-40123456789.123:5:-40123000000
++40123456789:9:40123456800
+-40123456789:9:-40123456800
++401234500:6:401234000
+-401234500:6:-401235000
+$round_mode = "odd"
++50123456789:5:50123000000
+-50123456789:5:-50123000000
++50123456789.123:5:50123000000
+-50123456789.123:5:-50123000000
++50123456789:9:50123456800
+-50123456789:9:-50123456800
++501234500:6:501235000
+-501234500:6:-501235000
+$round_mode = "even"
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601234000
+-601234500:6:-601234000
++60123456789.0123:5:60123000000
+-60123456789.0123:5:-60123000000
+&ffround
+$round_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNffround:5:NaN
++1.23:-1:1.2
++1.234:-1:1.2
++1.2345:-1:1.2
++1.23:-2:1.23
++1.234:-2:1.23
++1.2345:-2:1.23
++1.23:-3:1.230
++1.234:-3:1.234
++1.2345:-3:1.234
+-1.23:-1:-1.2
++1.27:-1:1.2
+-1.27:-1:-1.2
++1.25:-1:1.2
+-1.25:-1:-1.2
++1.35:-1:1.3
+-1.35:-1:-1.3
+-0.0061234567890:-1:0.0
+-0.0061:-1:0.0
+-0.00612:-1:0.0
+-0.00612:-2:0.00
+-0.006:-1:0.0
+-0.006:-2:0.00
+-0.0006:-2:0.00
+-0.0006:-3:0.000
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:0
+0.41:0:0
+$round_mode = "zero"
++2.23:-1:/2.2(?:0{5}\d+)?
+-2.23:-1:/-2.2(?:0{5}\d+)?
++2.27:-1:/2.(?:3|29{5}\d+)
+-2.27:-1:/-2.(?:3|29{5}\d+)
++2.25:-1:/2.2(?:0{5}\d+)?
+-2.25:-1:/-2.2(?:0{5}\d+)?
++2.35:-1:/2.(?:3|29{5}\d+)
+-2.35:-1:/-2.(?:3|29{5}\d+)
+-0.0065:-1:0.0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$round_mode = "+inf"
++3.23:-1:/3.2(?:0{5}\d+)?
+-3.23:-1:/-3.2(?:0{5}\d+)?
++3.27:-1:/3.(?:3|29{5}\d+)
+-3.27:-1:/-3.(?:3|29{5}\d+)
++3.25:-1:/3.(?:3|29{5}\d+)
+-3.25:-1:/-3.2(?:0{5}\d+)?
++3.35:-1:/3.(?:4|39{5}\d+)
+-3.35:-1:/-3.(?:3|29{5}\d+)
+-0.0065:-1:0.0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$round_mode = "-inf"
++4.23:-1:/4.2(?:0{5}\d+)?
+-4.23:-1:/-4.2(?:0{5}\d+)?
++4.27:-1:/4.(?:3|29{5}\d+)
+-4.27:-1:/-4.(?:3|29{5}\d+)
++4.25:-1:/4.2(?:0{5}\d+)?
+-4.25:-1:/-4.(?:3|29{5}\d+)
++4.35:-1:/4.(?:3|29{5}\d+)
+-4.35:-1:/-4.(?:4|39{5}\d+)
+-0.0065:-1:0.0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$round_mode = "odd"
++5.23:-1:/5.2(?:0{5}\d+)?
+-5.23:-1:/-5.2(?:0{5}\d+)?
++5.27:-1:/5.(?:3|29{5}\d+)
+-5.27:-1:/-5.(?:3|29{5}\d+)
++5.25:-1:/5.(?:3|29{5}\d+)
+-5.25:-1:/-5.(?:3|29{5}\d+)
++5.35:-1:/5.(?:3|29{5}\d+)
+-5.35:-1:/-5.(?:3|29{5}\d+)
+-0.0065:-1:0.0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$round_mode = "even"
++6.23:-1:/6.2(?:0{5}\d+)?
+-6.23:-1:/-6.2(?:0{5}\d+)?
++6.27:-1:/6.(?:3|29{5}\d+)
+-6.27:-1:/-6.(?:3|29{5}\d+)
++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+)
+-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+)
++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+)
+-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+)
+-0.0065:-1:0.0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+0.01234567:-3:0.012
+0.01234567:-4:0.0123
+0.01234567:-5:0.01235
+0.01234567:-6:0.012346
+0.01234567:-7:0.0123457
+0.01234567:-8:0.01234567
+0.01234567:-9:0.012345670
+0.01234567:-12:0.012345670000
+&fcmp
+fcmpNaN:fcmpNaN:
+fcmpNaN:+0:
++0:fcmpNaN:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
+-1.1:0:-1
++0:-1.1:1
++1.1:+0:1
++0:+1.1:-1
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+0:0.01:-1
+0:0.0001:-1
+0:-0.0001:1
+0:-0.1:1
+0.1:0:1
+0.00001:0:1
+-0.0001:0:-1
+-0.1:0:-1
+0:0.0001234:-1
+0:-0.0001234:1
+0.0001234:0:1
+-0.0001234:0:-1
+0.0001:0.0005:-1
+0.0005:0.0001:1
+0.005:0.0001:1
+0.001:0.0005:1
+0.000001:0.0005:-1
+0.00000123:0.0005:-1
+0.00512:0.0001:1
+0.005:0.000112:1
+0.00123:0.0005:1
+1.5:2:-1
+2:1.5:1
+1.54321:234:-1
+234:1.54321:1
+# infinity
+-inf:5432112345:-1
++inf:5432112345:1
+-inf:-5432112345:-1
++inf:-5432112345:1
+-inf:54321.12345:-1
++inf:54321.12345:1
+-inf:-54321.12345:-1
++inf:-54321.12345:1
++inf:+inf:0
+-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
+# return undef
++inf:NaN:
+NaN:inf:
+-inf:NaN:
+NaN:-inf:
+&facmp
+fcmpNaN:fcmpNaN:
+fcmpNaN:+0:
++0:fcmpNaN:
++0:+0:0
+-1:+0:1
++0:-1:-1
++1:+0:1
++0:+1:-1
+-1:+1:0
++1:-1:0
+-1:-1:0
++1:+1:0
+-1.1:0:1
++0:-1.1:-1
++1.1:+0:1
++0:+1.1:-1
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:1
+-12:-123:-1
++123:+124:-1
++124:+123:1
+-123:-124:-1
+-124:-123:1
+0:0.01:-1
+0:0.0001:-1
+0:-0.0001:-1
+0:-0.1:-1
+0.1:0:1
+0.00001:0:1
+-0.0001:0:1
+-0.1:0:1
+0:0.0001234:-1
+0:-0.0001234:-1
+0.0001234:0:1
+-0.0001234:0:1
+0.0001:0.0005:-1
+0.0005:0.0001:1
+0.005:0.0001:1
+0.001:0.0005:1
+0.000001:0.0005:-1
+0.00000123:0.0005:-1
+0.00512:0.0001:1
+0.005:0.000112:1
+0.00123:0.0005:1
+1.5:2:-1
+2:1.5:1
+1.54321:234:-1
+234:1.54321:1
+# infinity
+-inf:5432112345:1
++inf:5432112345:1
+-inf:-5432112345:1
++inf:-5432112345:1
+-inf:54321.12345:1
++inf:54321.12345:1
+-inf:-54321.12345:1
++inf:-54321.12345:1
++inf:+inf:0
+-inf:-inf:0
++inf:-inf:0
+-inf:+inf:0
+# return undef
++inf:facmpNaN:
+facmpNaN:inf:
+-inf:facmpNaN:
+facmpNaN:-inf:
+&fdec
+fdecNaN:NaN
++inf:inf
+-inf:-inf
++0:-1
++1:0
+-1:-2
+1.23:0.23
+-1.23:-2.23
+&finc
+fincNaN:NaN
++inf:inf
+-inf:-inf
++0:1
++1:2
+-1:0
+1.23:2.23
+-1.23:-0.23
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++inf:-inf:0
+-inf:+inf:0
++inf:+inf:inf
+-inf:-inf:-inf
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
++0:+0:0
++1:+0:1
++0:+1:1
++1:+1:2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:0
++1:-1:0
++9:+1:10
++99:+1:100
++999:+1:1000
++9999:+1:10000
++99999:+1:100000
++999999:+1:1000000
++9999999:+1:10000000
++99999999:+1:100000000
++999999999:+1:1000000000
++9999999999:+1:10000000000
++99999999999:+1:100000000000
++10:-1:9
++100:-1:99
++1000:-1:999
++10000:-1:9999
++100000:-1:99999
++1000000:-1:999999
++10000000:-1:9999999
++100000000:-1:99999999
++1000000000:-1:999999999
++10000000000:-1:9999999999
++123456789:+987654321:1111111110
+-123456789:+987654321:864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+0.001234:0.0001234:0.0013574
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:0
+-inf:-inf:0
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
++0:+0:0
++1:+0:1
++0:+1:-1
++1:+1:0
+-1:+0:-1
++0:-1:1
+-1:-1:0
+-1:+1:-2
++1:-1:2
++9:+1:8
++99:+1:98
++999:+1:998
++9999:+1:9998
++99999:+1:99998
++999999:+1:999998
++9999999:+1:9999998
++99999999:+1:99999998
++999999999:+1:999999998
++9999999999:+1:9999999998
++99999999999:+1:99999999998
++10:-1:11
++100:-1:101
++1000:-1:1001
++10000:-1:10001
++100000:-1:100001
++1000000:-1:1000001
++10000000:-1:10000001
++100000000:-1:100000001
++1000000000:-1:1000000001
++10000000000:-1:10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:864197532
++123456789:-987654321:1111111110
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++inf:NaNmul:NaN
++inf:NaNmul:NaN
+NaNmul:+inf:NaN
+NaNmul:-inf:NaN
++inf:+inf:inf
++inf:-inf:-inf
++inf:-inf:-inf
++inf:+inf:inf
++inf:123.34:inf
++inf:-123.34:-inf
+-inf:123.34:-inf
+-inf:-123.34:inf
+123.34:+inf:inf
+-123.34:+inf:-inf
+123.34:-inf:-inf
+-123.34:-inf:inf
++0:+0:0
++0:+1:0
++1:+0:0
++0:-1:0
+-1:+0:0
++123456789123456789:+0:0
++0:+123456789123456789:0
+-1:-1:1
+-1:+1:-1
++1:-1:-1
++1:+1:1
++2:+3:6
+-2:+3:-6
++2:-3:-6
+-2:-3:6
++111:+111:12321
++10101:+10101:102030201
++1001001:+1001001:1002003002001
++100010001:+100010001:10002000300020001
++10000100001:+10000100001:100002000030000200001
++11111111111:+9:99999999999
++22222222222:+9:199999999998
++33333333333:+9:299999999997
++44444444444:+9:399999999996
++55555555555:+9:499999999995
++66666666666:+9:599999999994
++77777777777:+9:699999999993
++88888888888:+9:799999999992
++99999999999:+9:899999999991
+6:120:720
+10:10000:100000
+&fdiv
+$div_scale = 40; $round_mode = 'even'
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
+-1:abc:NaN
+0:abc:NaN
++0:+0:NaN
++0:+1:0
++1:+0:inf
++3214:+0:inf
++0:-1:0
+-1:+0:-inf
+-3214:+0:-inf
++1:+1:1
+-1:-1:1
++1:-1:-1
+-1:+1:-1
++1:+2:0.5
++2:+1:2
+123:+inf:0
+123:-inf:0
++10:+5:2
++100:+4:25
++1000:+8:125
++10000:+16:625
++10000:-16:-625
++999999999999:+9:111111111111
++999999999999:+99:10101010101
++999999999999:+999:1001001001
++999999999999:+9999:100010001
++999999999999999:+99999:10000100001
++1000000000:+9:111111111.1111111111111111111111111111111
++2000000000:+9:222222222.2222222222222222222222222222222
++3000000000:+9:333333333.3333333333333333333333333333333
++4000000000:+9:444444444.4444444444444444444444444444444
++5000000000:+9:555555555.5555555555555555555555555555556
++6000000000:+9:666666666.6666666666666666666666666666667
++7000000000:+9:777777777.7777777777777777777777777777778
++8000000000:+9:888888888.8888888888888888888888888888889
++9000000000:+9:1000000000
++35500000:+113:314159.2920353982300884955752212389380531
++71000000:+226:314159.2920353982300884955752212389380531
++106500000:+339:314159.2920353982300884955752212389380531
++1000000000:+3:333333333.3333333333333333333333333333333
+2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447
+$div_scale = 20
++1000000000:+9:111111111.11111111111
++2000000000:+9:222222222.22222222222
++3000000000:+9:333333333.33333333333
++4000000000:+9:444444444.44444444444
++5000000000:+9:555555555.55555555556
++6000000000:+9:666666666.66666666667
++7000000000:+9:777777777.77777777778
++8000000000:+9:888888888.88888888889
++9000000000:+9:1000000000
+1:10:0.1
+1:100:0.01
+1:1000:0.001
+1:10000:0.0001
+1:504:0.001984126984126984127
+2:1.987654321:1.0062111801179738436
+# the next two cases are the "old" behaviour, but are now (>v0.01) different
+#+35500000:+113:314159.292035398230088
+#+71000000:+226:314159.292035398230088
++35500000:+113:314159.29203539823009
++71000000:+226:314159.29203539823009
++106500000:+339:314159.29203539823009
++1000000000:+3:333333333.33333333333
+$div_scale = 1
+# round to accuracy 1 after bdiv
++124:+3:40
+# reset scale for further tests
+$div_scale = 40
+&fmod
++0:0:NaN
++0:1:0
++3:1:0
+#+5:2:1
+#+9:4:1
+#+9:5:4
+#+9000:56:40
+#+56:9000:56
+&fsqrt
++0:0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.45:NaN
+nanfsqrt:NaN
++inf:inf
+-inf:NaN
++1:1
++2:1.41421356237309504880168872420969807857
++4:2
++16:4
++100:10
++123.456:11.11107555549866648462149404118219234119
++15241.38393:123.4559999756998444766131352122991626468
++1.44:1.2
+&is_odd
+abc:0
+0:0
+-1:1
+-3:1
+1:1
+3:1
+1000001:1
+1000002:0
++inf:0
+-inf:0
+123.45:0
+-123.45:0
+2:0
+&is_even
+abc:0
+0:1
+-1:0
+-3:0
+1:0
+3:0
+1000001:0
+1000002:1
+2:1
++inf:0
+-inf:0
+123.456:0
+-123.456:0
+&is_positive
+0:1
+1:1
+-1:0
+-123:0
+NaN:0
+-inf:0
++inf:1
+&is_negative
+0:0
+1:0
+-1:1
+-123:1
+NaN:0
+-inf:1
++inf:0
+&parts
+0:0 1
+1:1 0
+123:123 0
+-123:-123 0
+-1200:-12 2
+NaNparts:NaN NaN
++inf:inf inf
+-inf:-inf inf
+&exponent
+0:1
+1:0
+123:0
+-123:0
+-1200:2
++inf:inf
+-inf:inf
+NaNexponent:NaN
+&mantissa
+0:0
+1:1
+123:123
+-123:-123
+-1200:-12
++inf:inf
+-inf:-inf
+NaNmantissa:NaN
+&length
+123:3
+-123:3
+0:1
+1:1
+12345678901234567890:20
+&is_zero
+NaNzero:0
++inf:0
+-inf:0
+0:1
+-1:0
+1:0
+&is_one
+NaNone:0
++inf:0
+-inf:0
+0:0
+2:0
+1:1
+-1:0
+-2:0
+&bfloor
+0:0
+abc:NaN
++inf:inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-52
+12.2:12
+&bceil
+0:0
+abc:NaN
++inf:inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-51
+12.2:13
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 => 1162;
+ plan tests => 1273;
}
use Math::BigInt;
use Math::BigFloat;
-my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
-while (<DATA>)
- {
- chop;
- $_ =~ s/#.*$//; # remove comments
- $_ =~ s/\s+$//; # trailing spaces
- next if /^$/; # skip empty lines & comments
- if (s/^&//)
- {
- $f = $_;
- }
- elsif (/^\$/)
- {
- $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/; # rnd_mode, div_scale
- # print "$setup\n";
- }
- else
- {
- if (m|^(.*?):(/.+)$|)
- {
- $ans = $2;
- @args = split(/:/,$1,99);
- }
- else
- {
- @args = split(/:/,$_,99); $ans = pop(@args);
- }
- $try = "\$x = new Math::BigFloat \"$args[0]\";";
- if ($f eq "fnorm")
- {
- $try .= "\$x;";
- } elsif ($f eq "binf") {
- $try .= "\$x->binf('$args[1]');";
- } elsif ($f eq "bnan") {
- $try .= "\$x->bnan();";
- } elsif ($f eq "numify") {
- $try .= "\$x->numify();";
- } 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 "bsstr") {
- $try .= '$x->bsstr();';
- } elsif ($f eq "parts") {
- $try .= '($a,$b) = $x->parts(); "$a $b";';
- } elsif ($f eq "fneg") {
- $try .= '$x->bneg();';
- } elsif ($f eq "bfloor") {
- $try .= "\$x->bfloor();";
- } elsif ($f eq "bceil") {
- $try .= "\$x->bceil();";
- } elsif ($f eq "is_zero") {
- $try .= "\$x->is_zero()+0;";
- } elsif ($f eq "is_one") {
- $try .= "\$x->is_one()+0;";
- } elsif ($f eq "is_positive") {
- $try .= "\$x->is_positive()+0;";
- } elsif ($f eq "is_negative") {
- $try .= "\$x->is_negative()+0;";
- } elsif ($f eq "is_odd") {
- $try .= "\$x->is_odd()+0;";
- } elsif ($f eq "is_even") {
- $try .= "\$x->is_even()+0;";
- } elsif ($f eq "as_number") {
- $try .= "\$x->as_number();";
- } elsif ($f eq "fabs") {
- $try .= '$x->babs();';
- } elsif ($f eq "finc") {
- $try .= '++$x;';
- } elsif ($f eq "fdec") {
- $try .= '--$x;';
- }elsif ($f eq "fround") {
- $try .= "$setup; \$x->fround($args[1]);";
- } elsif ($f eq "ffround") {
- $try .= "$setup; \$x->ffround($args[1]);";
- } elsif ($f eq "fsqrt") {
- $try .= "$setup; \$x->fsqrt();";
- }
- else
- {
- $try .= "\$y = new Math::BigFloat \"$args[1]\";";
- if ($f eq "fcmp") {
- $try .= "\$x <=> \$y;";
- } elsif ($f eq "fpow") {
- $try .= "\$x ** \$y;";
- } elsif ($f eq "fadd") {
- $try .= "\$x + \$y;";
- } elsif ($f eq "fsub") {
- $try .= "\$x - \$y;";
- } elsif ($f eq "fmul") {
- $try .= "\$x * \$y;";
- } elsif ($f eq "fdiv") {
- $try .= "$setup; \$x / \$y;";
- } elsif ($f eq "fmod") {
- $try .= "\$x % \$y;";
- } else { warn "Unknown op '$f'"; }
- }
- $ans1 = eval $try;
- if ($ans =~ m|^/(.*)$|)
- {
- my $pat = $1;
- if ($ans1 =~ /$pat/)
- {
- ok (1,1);
- }
- else
- {
- print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
- }
- }
- else
- {
- if ($ans eq "")
- {
- ok_undef ($ans1);
- }
- else
- {
- print "# Tried: '$try'\n" if !ok ($ans1, $ans);
- if (ref($ans1) eq 'Math::BigFloat')
- {
- #print $ans1->_trailing_zeros(),"\n";
- print "# Has trailing zeros after '$try'\n"
- if !ok ($ans1->{_m}->_trailing_zeros(), 0);
- }
- }
- } # end pattern or string
- }
- } # end while
-
-# check whether new() for BigInts destroys them ($y == 12 in this case)
-$x = Math::BigInt->new(1200); $y = Math::BigFloat->new($x);
-ok ($y,1200); ok ($x,1200);
-
-# all done
-
-###############################################################################
-# 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');
- }
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+$class = "Math::BigFloat";
-__END__
-&as_number
-0:0
-1:1
-1.2:1
-2.345:2
--2:-2
--123.456:-123
--200:-200
-&binf
-1:+:inf
-2:-:-inf
-3:abc:inf
-&numify
-0:0e+1
-+1:1e+0
-1234:1234e+0
-NaN:NaN
-+inf:inf
--inf:-inf
-&bnan
-abc:NaN
-2:NaN
--2:NaN
-0:NaN
-&bone
-2:+:1
--2:-:-1
--2:+:1
-2:-:-1
-0::1
--2::1
-abc::1
-2:abc:1
-&bsstr
-+inf:inf
--inf:-inf
-abcbsstr:NaN
-1234.567:1234567e-3
-&bstr
-+inf:::inf
--inf:::-inf
-abcbsstr:::NaN
-1234.567:9::1234.56700
-1234.567::-6:1234.567000
-12345:5::12345
-0.001234:6::0.00123400
-0.001234::-8:0.00123400
-0:4::0
-0::-4:0.0000
-&fnorm
-+inf:inf
--inf:-inf
-+infinity:NaN
-+-inf:NaN
-abc:NaN
- 1 a:NaN
-1bcd2:NaN
-11111b:NaN
-+1z:NaN
--1z:NaN
-0:0
-+0:0
-+00:0
-+0_0_0:0
-000000_0000000_00000:0
--0:0
--0000:0
-+1:1
-+01:1
-+001:1
-+00000100000:100000
-123456789:123456789
--1:-1
--01:-1
--001:-1
--123456789:-123456789
--00000100000:-100000
-123.456a:NaN
-123.456:123.456
-0.01:0.01
-.002:0.002
-+.2:0.2
--0.0003:-0.0003
--.0000000004:-0.0000000004
-123456E2:12345600
-123456E-2:1234.56
--123456E2:-12345600
--123456E-2:-1234.56
-1e1:10
-2e-11:0.00000000002
-# excercise _split
- .02e-1:0.002
- 000001:1
- -00001:-1
- -1:-1
- 000.01:0.01
- -000.0023:-0.0023
- 1.1e1:11
--3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
--4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
-&fpow
-2:2:4
-1:2:1
-1:3:1
--1:2:1
--1:3:-1
-123.456:2:15241.383936
-2:-2:0.25
-2:-3:0.125
-128:-2:0.00006103515625
-abc:123.456:NaN
-123.456:abc:NaN
-+inf:123.45:inf
--inf:123.45:-inf
-+inf:-123.45:inf
--inf:-123.45:-inf
-&fneg
-fnegNaN:NaN
-+inf:-inf
--inf:inf
-+0:0
-+1:-1
--1:1
-+123456789:-123456789
--123456789:123456789
-+123.456789:-123.456789
--123456.789:123456.789
-&fabs
-fabsNaN:NaN
-+inf:inf
--inf:inf
-+0:0
-+1:1
--1:1
-+123456789:123456789
--123456789:123456789
-+123.456789:123.456789
--123456.789:123456.789
-&fround
-$rnd_mode = "trunc"
-+inf:5:inf
--inf:5:-inf
-0:5:0
-NaNfround:5:NaN
-+10123456789:5:10123000000
--10123456789:5:-10123000000
-+10123456789.123:5:10123000000
--10123456789.123:5:-10123000000
-+10123456789:9:10123456700
--10123456789:9:-10123456700
-+101234500:6:101234000
--101234500:6:-101234000
-$rnd_mode = "zero"
-+20123456789:5:20123000000
--20123456789:5:-20123000000
-+20123456789.123:5:20123000000
--20123456789.123:5:-20123000000
-+20123456789:9:20123456800
--20123456789:9:-20123456800
-+201234500:6:201234000
--201234500:6:-201234000
-$rnd_mode = "+inf"
-+30123456789:5:30123000000
--30123456789:5:-30123000000
-+30123456789.123:5:30123000000
--30123456789.123:5:-30123000000
-+30123456789:9:30123456800
--30123456789:9:-30123456800
-+301234500:6:301235000
--301234500:6:-301234000
-$rnd_mode = "-inf"
-+40123456789:5:40123000000
--40123456789:5:-40123000000
-+40123456789.123:5:40123000000
--40123456789.123:5:-40123000000
-+40123456789:9:40123456800
--40123456789:9:-40123456800
-+401234500:6:401234000
--401234500:6:-401235000
-$rnd_mode = "odd"
-+50123456789:5:50123000000
--50123456789:5:-50123000000
-+50123456789.123:5:50123000000
--50123456789.123:5:-50123000000
-+50123456789:9:50123456800
--50123456789:9:-50123456800
-+501234500:6:501235000
--501234500:6:-501235000
-$rnd_mode = "even"
-+60123456789:5:60123000000
--60123456789:5:-60123000000
-+60123456789:9:60123456800
--60123456789:9:-60123456800
-+601234500:6:601234000
--601234500:6:-601234000
-+60123456789.0123:5:60123000000
--60123456789.0123:5:-60123000000
-&ffround
-$rnd_mode = "trunc"
-+inf:5:inf
--inf:5:-inf
-0:5:0
-NaNffround:5:NaN
-+1.23:-1:1.2
-+1.234:-1:1.2
-+1.2345:-1:1.2
-+1.23:-2:1.23
-+1.234:-2:1.23
-+1.2345:-2:1.23
-+1.23:-3:1.23
-+1.234:-3:1.234
-+1.2345:-3:1.234
--1.23:-1:-1.2
-+1.27:-1:1.2
--1.27:-1:-1.2
-+1.25:-1:1.2
--1.25:-1:-1.2
-+1.35:-1:1.3
--1.35:-1:-1.3
--0.0061234567890:-1:0
--0.0061:-1:0
--0.00612:-1:0
--0.00612:-2:0
--0.006:-1:0
--0.006:-2:0
--0.0006:-2:0
--0.0006:-3:0
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:0
-0.41:0:0
-$rnd_mode = "zero"
-+2.23:-1:/2.2(?:0{5}\d+)?
--2.23:-1:/-2.2(?:0{5}\d+)?
-+2.27:-1:/2.(?:3|29{5}\d+)
--2.27:-1:/-2.(?:3|29{5}\d+)
-+2.25:-1:/2.2(?:0{5}\d+)?
--2.25:-1:/-2.2(?:0{5}\d+)?
-+2.35:-1:/2.(?:3|29{5}\d+)
--2.35:-1:/-2.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-$rnd_mode = "+inf"
-+3.23:-1:/3.2(?:0{5}\d+)?
--3.23:-1:/-3.2(?:0{5}\d+)?
-+3.27:-1:/3.(?:3|29{5}\d+)
--3.27:-1:/-3.(?:3|29{5}\d+)
-+3.25:-1:/3.(?:3|29{5}\d+)
--3.25:-1:/-3.2(?:0{5}\d+)?
-+3.35:-1:/3.(?:4|39{5}\d+)
--3.35:-1:/-3.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-6e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:1
-0.51:0:1
-0.41:0:0
-$rnd_mode = "-inf"
-+4.23:-1:/4.2(?:0{5}\d+)?
--4.23:-1:/-4.2(?:0{5}\d+)?
-+4.27:-1:/4.(?:3|29{5}\d+)
--4.27:-1:/-4.(?:3|29{5}\d+)
-+4.25:-1:/4.2(?:0{5}\d+)?
--4.25:-1:/-4.(?:3|29{5}\d+)
-+4.35:-1:/4.(?:3|29{5}\d+)
--4.35:-1:/-4.(?:4|39{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.007|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-$rnd_mode = "odd"
-+5.23:-1:/5.2(?:0{5}\d+)?
--5.23:-1:/-5.2(?:0{5}\d+)?
-+5.27:-1:/5.(?:3|29{5}\d+)
--5.27:-1:/-5.(?:3|29{5}\d+)
-+5.25:-1:/5.(?:3|29{5}\d+)
--5.25:-1:/-5.(?:3|29{5}\d+)
-+5.35:-1:/5.(?:3|29{5}\d+)
--5.35:-1:/-5.(?:3|29{5}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.007|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:1
-0.51:0:1
-0.41:0:0
-$rnd_mode = "even"
-+6.23:-1:/6.2(?:0{5}\d+)?
--6.23:-1:/-6.2(?:0{5}\d+)?
-+6.27:-1:/6.(?:3|29{5}\d+)
--6.27:-1:/-6.(?:3|29{5}\d+)
-+6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+)
--6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+)
-+6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+)
--6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+)
--0.0065:-1:0
--0.0065:-2:/-0\.01|-1e-02
--0.0065:-3:/-0\.006|-7e-03
--0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
--0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
-0.05:0:0
-0.5:0:0
-0.51:0:1
-0.41:0:0
-0.01234567:-3:0.012
-0.01234567:-4:0.0123
-0.01234567:-5:0.01235
-0.01234567:-6:0.012346
-0.01234567:-7:0.0123457
-0.01234567:-8:0.01234567
-0.01234567:-9:0.01234567
-0.01234567:-12:0.01234567
-&fcmp
-fcmpNaN:fcmpNaN:
-fcmpNaN:+0:
-+0:fcmpNaN:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
--1:-1:0
-+1:+1:0
--1.1:0:-1
-+0:-1.1:1
-+1.1:+0:1
-+0:+1.1:-1
-+123:+123:0
-+123:+12:1
-+12:+123:-1
--123:-123:0
--123:-12:-1
--12:-123:1
-+123:+124:-1
-+124:+123:1
--123:-124:1
--124:-123:-1
-0:0.01:-1
-0:0.0001:-1
-0:-0.0001:1
-0:-0.1:1
-0.1:0:1
-0.00001:0:1
--0.0001:0:-1
--0.1:0:-1
-0:0.0001234:-1
-0:-0.0001234:1
-0.0001234:0:1
--0.0001234:0:-1
-0.0001:0.0005:-1
-0.0005:0.0001:1
-0.005:0.0001:1
-0.001:0.0005:1
-0.000001:0.0005:-1
-0.00000123:0.0005:-1
-0.00512:0.0001:1
-0.005:0.000112:1
-0.00123:0.0005:1
-1.5:2:-1
-2:1.5:1
-1.54321:234:-1
-234:1.54321:1
-# infinity
--inf:5432112345:-1
-+inf:5432112345:1
--inf:-5432112345:-1
-+inf:-5432112345:1
--inf:54321.12345:-1
-+inf:54321.12345:1
--inf:-54321.12345:-1
-+inf:-54321.12345:1
-+inf:+inf:0
--inf:-inf:0
-+inf:-inf:1
--inf:+inf:-1
-# return undef
-+inf:NaN:
-NaN:inf:
--inf:NaN:
-NaN:-inf:
-&fdec
-fdecNaN:NaN
-+inf:inf
--inf:-inf
-+0:-1
-+1:0
--1:-2
-1.23:0.23
--1.23:-2.23
-&finc
-fincNaN:NaN
-+inf:inf
--inf:-inf
-+0:1
-+1:2
--1:0
-1.23:2.23
--1.23:-0.23
-&fadd
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+inf:-inf:0
--inf:+inf:0
-+inf:+inf:inf
--inf:-inf:-inf
-baddNaN:+inf:NaN
-baddNaN:+inf:NaN
-+inf:baddNaN:NaN
--inf:baddNaN:NaN
-+0:+0:0
-+1:+0:1
-+0:+1:1
-+1:+1:2
--1:+0:-1
-+0:-1:-1
--1:-1:-2
--1:+1:0
-+1:-1:0
-+9:+1:10
-+99:+1:100
-+999:+1:1000
-+9999:+1:10000
-+99999:+1:100000
-+999999:+1:1000000
-+9999999:+1:10000000
-+99999999:+1:100000000
-+999999999:+1:1000000000
-+9999999999:+1:10000000000
-+99999999999:+1:100000000000
-+10:-1:9
-+100:-1:99
-+1000:-1:999
-+10000:-1:9999
-+100000:-1:99999
-+1000000:-1:999999
-+10000000:-1:9999999
-+100000000:-1:99999999
-+1000000000:-1:999999999
-+10000000000:-1:9999999999
-+123456789:+987654321:1111111110
--123456789:+987654321:864197532
--123456789:-987654321:-1111111110
-+123456789:-987654321:-864197532
-0.001234:0.0001234:0.0013574
-&fsub
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+inf:-inf:inf
--inf:+inf:-inf
-+inf:+inf:0
--inf:-inf:0
-baddNaN:+inf:NaN
-baddNaN:+inf:NaN
-+inf:baddNaN:NaN
--inf:baddNaN:NaN
-+0:+0:0
-+1:+0:1
-+0:+1:-1
-+1:+1:0
--1:+0:-1
-+0:-1:1
--1:-1:0
--1:+1:-2
-+1:-1:2
-+9:+1:8
-+99:+1:98
-+999:+1:998
-+9999:+1:9998
-+99999:+1:99998
-+999999:+1:999998
-+9999999:+1:9999998
-+99999999:+1:99999998
-+999999999:+1:999999998
-+9999999999:+1:9999999998
-+99999999999:+1:99999999998
-+10:-1:11
-+100:-1:101
-+1000:-1:1001
-+10000:-1:10001
-+100000:-1:100001
-+1000000:-1:1000001
-+10000000:-1:10000001
-+100000000:-1:100000001
-+1000000000:-1:1000000001
-+10000000000:-1:10000000001
-+123456789:+987654321:-864197532
--123456789:+987654321:-1111111110
--123456789:-987654321:864197532
-+123456789:-987654321:1111111110
-&fmul
-abc:abc:NaN
-abc:+0:NaN
-+0:abc:NaN
-+inf:NaNmul:NaN
-+inf:NaNmul:NaN
-NaNmul:+inf:NaN
-NaNmul:-inf:NaN
-+inf:+inf:inf
-+inf:-inf:-inf
-+inf:-inf:-inf
-+inf:+inf:inf
-+inf:123.34:inf
-+inf:-123.34:-inf
--inf:123.34:-inf
--inf:-123.34:inf
-123.34:+inf:inf
--123.34:+inf:-inf
-123.34:-inf:-inf
--123.34:-inf:inf
-+0:+0:0
-+0:+1:0
-+1:+0:0
-+0:-1:0
--1:+0:0
-+123456789123456789:+0:0
-+0:+123456789123456789:0
--1:-1:1
--1:+1:-1
-+1:-1:-1
-+1:+1:1
-+2:+3:6
--2:+3:-6
-+2:-3:-6
--2:-3:6
-+111:+111:12321
-+10101:+10101:102030201
-+1001001:+1001001:1002003002001
-+100010001:+100010001:10002000300020001
-+10000100001:+10000100001:100002000030000200001
-+11111111111:+9:99999999999
-+22222222222:+9:199999999998
-+33333333333:+9:299999999997
-+44444444444:+9:399999999996
-+55555555555:+9:499999999995
-+66666666666:+9:599999999994
-+77777777777:+9:699999999993
-+88888888888:+9:799999999992
-+99999999999:+9:899999999991
-6:120:720
-10:10000:100000
-&fdiv
-$div_scale = 40; $Math::BigFloat::rnd_mode = 'even'
-abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
--1:abc:NaN
-0:abc:NaN
-+0:+0:NaN
-+0:+1:0
-+1:+0:inf
-+3214:+0:inf
-+0:-1:0
--1:+0:-inf
--3214:+0:-inf
-+1:+1:1
--1:-1:1
-+1:-1:-1
--1:+1:-1
-+1:+2:0.5
-+2:+1:2
-123:+inf:0
-123:-inf:0
-+10:+5:2
-+100:+4:25
-+1000:+8:125
-+10000:+16:625
-+10000:-16:-625
-+999999999999:+9:111111111111
-+999999999999:+99:10101010101
-+999999999999:+999:1001001001
-+999999999999:+9999:100010001
-+999999999999999:+99999:10000100001
-+1000000000:+9:111111111.1111111111111111111111111111111
-+2000000000:+9:222222222.2222222222222222222222222222222
-+3000000000:+9:333333333.3333333333333333333333333333333
-+4000000000:+9:444444444.4444444444444444444444444444444
-+5000000000:+9:555555555.5555555555555555555555555555556
-+6000000000:+9:666666666.6666666666666666666666666666667
-+7000000000:+9:777777777.7777777777777777777777777777778
-+8000000000:+9:888888888.8888888888888888888888888888889
-+9000000000:+9:1000000000
-+35500000:+113:314159.2920353982300884955752212389380531
-+71000000:+226:314159.2920353982300884955752212389380531
-+106500000:+339:314159.2920353982300884955752212389380531
-+1000000000:+3:333333333.3333333333333333333333333333333
-2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447
-$div_scale = 20
-+1000000000:+9:111111111.11111111111
-+2000000000:+9:222222222.22222222222
-+3000000000:+9:333333333.33333333333
-+4000000000:+9:444444444.44444444444
-+5000000000:+9:555555555.55555555556
-+6000000000:+9:666666666.66666666667
-+7000000000:+9:777777777.77777777778
-+8000000000:+9:888888888.88888888889
-+9000000000:+9:1000000000
-1:10:0.1
-1:100:0.01
-1:1000:0.001
-1:10000:0.0001
-1:504:0.001984126984126984127
-2:1.987654321:1.0062111801179738436
-# the next two cases are the "old" behaviour, but are now (>v0.01) different
-#+35500000:+113:314159.292035398230088
-#+71000000:+226:314159.292035398230088
-+35500000:+113:314159.29203539823009
-+71000000:+226:314159.29203539823009
-+106500000:+339:314159.29203539823009
-+1000000000:+3:333333333.33333333333
-$div_scale = 1
-# round to accuracy 1 after bdiv
-+124:+3:40
-# reset scale for further tests
-$div_scale = 40
-&fmod
-+0:0:NaN
-+0:1:0
-+3:1:0
-#+5:2:1
-#+9:4:1
-#+9:5:4
-#+9000:56:40
-#+56:9000:56
-&fsqrt
-+0:0
--1:NaN
--2:NaN
--16:NaN
--123.45:NaN
-nanfsqrt:NaN
-+inf:inf
--inf:NaN
-+1:1
-+2:1.41421356237309504880168872420969807857
-+4:2
-+16:4
-+100:10
-+123.456:11.11107555549866648462149404118219234119
-+15241.38393:123.4559999756998444766131352122991626468
-+1.44:1.2
-&is_odd
-abc:0
-0:0
--1:1
--3:1
-1:1
-3:1
-1000001:1
-1000002:0
-+inf:0
--inf:0
-123.45:0
--123.45:0
-2:0
-&is_even
-abc:0
-0:1
--1:0
--3:0
-1:0
-3:0
-1000001:0
-1000002:1
-2:1
-+inf:0
--inf:0
-123.456:0
--123.456:0
-&is_positive
-0:1
-1:1
--1:0
--123:0
-NaN:0
--inf:0
-+inf:1
-&is_negative
-0:0
-1:0
--1:1
--123:1
-NaN:0
--inf:1
-+inf:0
-&parts
-0:0 1
-1:1 0
-123:123 0
--123:-123 0
--1200:-12 2
-&is_zero
-NaNzero:0
-+inf:0
--inf:0
-0:1
--1:0
-1:0
-&is_one
-NaNone:0
-+inf:0
--inf:0
-0:0
-2:0
-1:1
--1:0
--2:0
-&bfloor
-0:0
-abc:NaN
-+inf:inf
--inf:-inf
-1:1
--51:-51
--51.2:-52
-12.2:12
-&bceil
-0:0
-abc:NaN
-+inf:inf
--inf:-inf
-1:1
--51:-51
--51.2:-51
-12.2:13
+require 'bigfltpm.inc'; # all tests here for sharing
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 1447;
+ plan tests => 1457;
}
-my $version = '1.42'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.43'; # for $VERSION tests, match current release (by hand!)
##############################################################################
# for testing inheritance of _swap
$ans = pop(@args);
$try = "\$x = Math::BigInt->new(\"$args[0]\");";
if ($f eq "bnorm"){
- # $try .= '$x+0;';
+ $try = "\$x = Math::BigInt::bnorm(\"$args[0]\");";
} elsif ($f eq "is_zero") {
- $try .= '$x->is_zero()+0;';
+ $try .= '$x->is_zero();';
} elsif ($f eq "is_one") {
- $try .= '$x->is_one()+0;';
+ $try .= '$x->is_one();';
} elsif ($f eq "is_odd") {
- $try .= '$x->is_odd()+0;';
+ $try .= '$x->is_odd();';
} elsif ($f eq "is_even") {
- $try .= '$x->is_even()+0;';
+ $try .= '$x->is_even();';
} elsif ($f eq "is_negative") {
- $try .= '$x->is_negative()+0;';
+ $try .= '$x->is_negative();';
} elsif ($f eq "is_positive") {
- $try .= '$x->is_positive()+0;';
+ $try .= '$x->is_positive();';
} 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]')+0;";
+ $try .= "\$x->is_inf('$args[1]');";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
} elsif ($f eq "bone") {
}elsif ($f eq "bsqrt") {
$try .= '$x->bsqrt();';
}elsif ($f eq "length") {
- $try .= "\$x->length();";
+ $try .= '$x->length();';
}elsif ($f eq "exponent"){
+ # ->bstr() to see if a BigInt is returned
$try .= '$x = $x->exponent()->bstr();';
}elsif ($f eq "mantissa"){
+ # ->bstr() to see if a BigInt is returned
$try .= '$x = $x->mantissa()->bstr();';
}elsif ($f eq "parts"){
- $try .= "(\$m,\$e) = \$x->parts();";
+ $try .= '($m,$e) = $x->parts();';
+ # ->bstr() to see if a BigInt 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 "bround") {
$try .= "$round_mode; \$x->bround(\$y);";
}elsif ($f eq "bacmp"){
- $try .= "\$x->bacmp(\$y);";
+ $try .= '$x->bacmp($y);';
}elsif ($f eq "badd"){
- $try .= "\$x + \$y;";
+ $try .= '$x + $y;';
}elsif ($f eq "bsub"){
- $try .= "\$x - \$y;";
+ $try .= '$x - $y;';
}elsif ($f eq "bmul"){
- $try .= "\$x * \$y;";
+ $try .= '$x * $y;';
}elsif ($f eq "bdiv"){
- $try .= "\$x / \$y;";
+ $try .= '$x / $y;';
}elsif ($f eq "bdiv-list"){
$try .= 'join (",",$x->bdiv($y));';
}elsif ($f eq "bmod"){
- $try .= "\$x % \$y;";
+ $try .= '$x % $y;';
}elsif ($f eq "bgcd")
{
if (defined $args[2])
}
else
{
- #print "try: $try ans: $ans1 $ans\n";
+ # print "try: $try ans: $ans1 $ans\n";
print "# Tried: '$try'\n" if !ok ($ans1, $ans);
}
# check internal state of number objects
# test for floating-point input (other tests in bnorm() below)
$z = 1050000000000000; # may be int on systems with 64bit?
-$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13'); # not 1.03e+15
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13'); # not 1.05e+15
$z = 1e+129; # definitely a float (may fail on UTS)
-$x = Math::BigInt->new($z); ok ($x->bsstr(),$z);
+# don't compare to $z, since some Perl versions stringify $z into something
+# like '1.e+129' or something equally ugly
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'1e+129');
###############################################################################
# prime number tests, also test for **= and length()
# 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 'inf'
+# like 1e100000 crash on some platforms. So simple test for the string 'inf'
$x = Math::BigInt->new('+inf'); ok ($x,'inf');
-###############################################################################
-# all tests done
+### all tests done ############################################################
###############################################################################
# Perl 5.005 does not like ok ($x,undef)
0x1_2_3_4_56_78:305419896
0x_123:NaN
# inf input
+inf:inf
+inf:inf
-inf:-inf
0inf:NaN
4:-3:-2
123:+inf:0
123:-inf:0
+10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576
&bmod
abc:abc:NaN
abc:+1:abc:NaN
123:123
-1:-1
-2:-2
++inf:inf
+-inf:-inf
&exponent
abc:NaN
1e4:4
-1:0
-2:0
0:1
++inf:inf
+-inf:inf
&parts
abc:NaN,NaN
1e4:1,4
-1:-1,0
-2:-2,0
0:0,1
++inf:inf,inf
+-inf:-inf,inf
&bpow
abc:12:NaN
12:abc:NaN
--- /dev/null
+#!/usr/bin/perl -w
+
+# test calling conventions
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # chdir 't' if -d 't';
+ unshift @INC, '../lib'; # for running manually
+ plan tests => 100;
+ }
+
+package Math::BigInt::Test;
+
+use Math::BigInt;
+use vars qw/@ISA/;
+@ISA = qw/Math::BigInt/; # child of MBI
+use overload;
+
+package Math::BigFloat::Test;
+
+use Math::BigFloat;
+use vars qw/@ISA/;
+@ISA = qw/Math::BigFloat/; # child of MBI
+use overload;
+
+package main;
+
+use Math::BigInt;
+use Math::BigFloat;
+
+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>)
+ {
+ chop;
+ next if /^#/; # skip comments
+ if (s/^&//)
+ {
+ $func = $_;
+ }
+ else
+ {
+ @args = split(/:/,$_,99);
+ $ans = pop @args;
+ foreach $class (qw/
+ Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
+ {
+ $try = "$class\->$func('$args[0]');";
+ $rc = eval $try;
+ print "# Tried: '$try'\n" if !ok ($rc, $ans);
+ }
+ }
+
+ }
+
+# all done
+
+###############################################################################
+# 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');
+ }
+
+__END__
+&is_zero
+1:0
+0:1
+&is_one
+1:1
+0:0
+&is_positive
+1:1
+-1:0
+&is_negative
+1:0
+-1:1
+&is_nan
+abc:1
+1:0
+&is_inf
+inf:1
+0:0
+&bstr
+5:5
+10:10
+abc:NaN
++inf:inf
+-inf:-inf
+&bsstr
+1:1e+0
+0:0e+1
+2:2e+0
+200:2e+2
+&babs
+-1:1
+1:1
+&bnot
+-2:1
+1:-2
#!/usr/bin/perl -w
-# test accuracy, precicion and fallback, round_mode
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes
use strict;
use Test;
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 103;
+ plan tests => 246;
}
+# for finding out whether round finds correct class
+package Foo;
+
+use Math::BigInt;
+use vars qw/@ISA $precision $accuracy $div_scale $round_mode/;
+@ISA = qw/Math::BigInt/;
+
+$precision = 6;
+$accuracy = 8;
+$div_scale = 5;
+$round_mode = 'odd';
+
+sub new
+ {
+ my $class = shift;
+ my $self = { _a => undef, _p => undef, value => 5 };
+ bless $self, $class;
+ }
+
+sub bstr
+ {
+ my $self = shift;
+
+ return "$self->{value}";
+ }
+
+# these will be called with the rounding precision or accuracy, depending on
+# class
+sub bround
+ {
+ my ($self,$a,$r) = @_;
+ $self->{value} = 'a' x $a;
+ return $self;
+ }
+
+sub bnorm
+ {
+ my $self = shift;
+ return $self;
+ }
+
+sub bfround
+ {
+ my ($self,$p,$r) = @_;
+ $self->{value} = 'p' x $p;
+ return $self;
+ }
+
+package main;
+
use Math::BigInt;
use Math::BigFloat;
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::rnd_mode,'even');
ok_undef ($Math::BigFloat::accuracy);
ok_undef ($Math::BigFloat::precision);
+ok_undef (Math::BigFloat->accuracy());
+ok_undef (Math::BigFloat->precision());
ok ($Math::BigFloat::div_scale,40);
-ok ($Math::BigFloat::rnd_mode,'even');
+ok (Math::BigFloat::div_scale(),40);
+ok ($Math::BigFloat::round_mode,'even');
+ok (Math::BigFloat::round_mode(),'even');
+
+# accessors
+foreach my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ ok_undef ($class->accuracy());
+ ok_undef ($class->precision());
+ ok ($class->round_mode(),'even');
+ ok ($class->div_scale(),40);
+
+ ok ($class->div_scale(20),20);
+ $class->div_scale(40); ok ($class->div_scale(),40);
+
+ ok ($class->round_mode('odd'),'odd');
+ $class->round_mode('even'); ok ($class->round_mode(),'even');
+
+ ok ($class->accuracy(2),2);
+ $class->accuracy(3); ok ($class->accuracy(),3);
+ ok_undef ($class->accuracy(undef));
+
+ ok ($class->precision(2),2);
+ ok ($class->precision(-2),-2);
+ $class->precision(3); ok ($class->precision(),3);
+ ok_undef ($class->precision(undef));
+ }
# accuracy
foreach (qw/5 42 -1 0/)
# round_mode
foreach (qw/odd even zero trunc +inf -inf/)
{
- ok ($Math::BigFloat::rnd_mode = $_,$_);
- ok ($Math::BigInt::rnd_mode = $_,$_);
+ ok ($Math::BigFloat::round_mode = $_,$_);
+ ok ($Math::BigInt::round_mode = $_,$_);
}
-$Math::BigFloat::rnd_mode = 4;
-ok ($Math::BigFloat::rnd_mode,4);
-ok ($Math::BigInt::rnd_mode,'-inf'); # from above
+$Math::BigFloat::round_mode = 'zero';
+ok ($Math::BigFloat::round_mode,'zero');
+ok ($Math::BigInt::round_mode,'-inf'); # from above
$Math::BigInt::accuracy = undef;
$Math::BigInt::precision = undef;
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);
+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);
+ok ($x->precision(-2),-2);
+ok ($x->accuracy(4),4); # clear P
+ok_undef ($x->precision());
+
# does copy work?
$x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
-$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2);
+$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
###############################################################################
# test wether operations round properly afterwards
$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);
$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,123460);
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
+$x = Math::BigInt->new(123400); $x->{_a} = 4;
+ok ($x->bnot(),-123400); # 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
+$x = Math::BigInt->new(-123401); $x->{_a} = 4;
+ok ($x->babs(),123401);
+$x = Math::BigInt->new(-123401); $x->{_a} = 4;
+ok ($x->bneg(),123401);
+
###############################################################################
# test mixed arguments
# $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
# $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
+###############################################################################
+# rounding in bdiv with fallback and already set A or P
+
+$Math::BigFloat::accuracy = undef;
+$Math::BigFloat::precision = undef;
+$Math::BigFloat::div_scale = 40;
+
+$x = Math::BigFloat->new(10); $x->{_a} = 4;
+ok ($x->bdiv(3),'3.333');
+ok ($x->{_a},4); # set's it since no fallback
+
+$x = Math::BigFloat->new(10); $x->{_a} = 4; $y = Math::BigFloat->new(3);
+ok ($x->bdiv($y),'3.333');
+ok ($x->{_a},4); # set's it since no fallback
+
+# rounding to P of x
+$x = Math::BigFloat->new(10); $x->{_p} = -2;
+ok ($x->bdiv(3),'3.33');
+
+# round in div with requested P
+$x = Math::BigFloat->new(10);
+ok ($x->bdiv(3,undef,-2),'3.33');
+
+# round in div with requested P greater than fallback
+$Math::BigFloat::div_scale = 5;
+$x = Math::BigFloat->new(10);
+ok ($x->bdiv(3,undef,-8),'3.33333333');
+$Math::BigFloat::div_scale = 40;
+
+$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_a} = 4;
+ok ($x->bdiv($y),'3.333');
+ok ($x->{_a},4); ok ($y->{_a},4); # set's it since no fallback
+ok_undef ($x->{_p}); ok_undef ($y->{_p});
+
+# rounding to P of y
+$x = Math::BigFloat->new(10); $y = Math::BigFloat->new(3); $y->{_p} = -2;
+ok ($x->bdiv($y),'3.33');
+ok ($x->{_p},-2);
+ ok ($y->{_p},-2);
+ok_undef ($x->{_a}); ok_undef ($y->{_a});
+
+###############################################################################
+# test whether bround(-n) fails in MBF (undocumented in MBI)
+eval { $x = Math::BigFloat->new(1); $x->bround(-2); };
+ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
+
+# test whether rounding to higher accuracy is no-op
+$x = Math::BigFloat->new(1); $x->{_a} = 4;
+ok ($x,'1.000');
+$x->bround(6); # must be no-op
+ok ($x->{_a},4);
+ok ($x,'1.000');
+
+$x = Math::BigInt->new(1230); $x->{_a} = 3;
+ok ($x,'1230');
+$x->bround(6); # must be no-op
+ok ($x->{_a},3);
+ok ($x,'1230');
+
+# bround(n) should set _a
+$x->bround(2); # smaller works
+ok ($x,'1200');
+ok ($x->{_a},2);
+
+# bround(-n) is undocumented and only used by MBF
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345);
+$x->bround(-1);
+ok ($x,'12300');
+ok ($x->{_a},4);
+
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345);
+$x->bround(-2);
+ok ($x,'12000');
+ok ($x->{_a},3);
+
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(-3);
+ok ($x,'10000');
+ok ($x->{_a},2);
+
+# bround(-n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(-4);
+ok ($x,'00000');
+ok ($x->{_a},1);
+
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(12345);
+$x->bround(-5);
+ok ($x,'0'); # scale to "big" => 0
+ok ($x->{_a},0);
+
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(54321);
+$x->bround(-5);
+ok ($x,'100000'); # used by MBF to round 0.0054321 at 0.0_6_00000
+ok ($x->{_a},0);
+
+# bround(-n) should be noop if n too big
+$x = Math::BigInt->new(54321); $x->{_a} = 5;
+$x->bround(-6);
+ok ($x,'100000'); # no-op
+ok ($x->{_a},0);
+
+# bround(n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(5); # must be no-op
+ok ($x,'12345');
+ok ($x->{_a},5);
+
+# bround(n) should set _a
+$x = Math::BigInt->new(12345); $x->{_a} = 5;
+$x->bround(6); # must be no-op
+ok ($x,'12345');
+
+$x = Math::BigFloat->new(0.0061); $x->bfround(-2);
+ok ($x,0.01);
+
+###############################################################################
+# rounding with already set precision/accuracy
+
+$x = Math::BigFloat->new(1); $x->{_p} = -5;
+ok ($x,'1.00000');
+
+# further rounding donw
+ok ($x->bfround(-2),'1.00');
+ok ($x->{_p},-2);
+
+$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;
+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);
+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});
+ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
+
+# check for no A/P in case of fallback
+# result
+$x = Math::BigFloat->new(100) / 3;
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+# result & reminder
+$x = Math::BigFloat->new(100) / 3; ($x,$y) = $x->bdiv(3);
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ok_undef ($y->{_a}); ok_undef ($y->{_p});
+
+###############################################################################
+# math with two numbers with differen A and P
+
+$x = Math::BigFloat->new(12345); $x->accuracy(4); # '12340'
+$y = Math::BigFloat->new(12345); $y->accuracy(2); # '12000'
+ok ($x+$y,24000); # 12340+12000=> 24340 => 24000
+
+$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
+
+###############################################################################
+# round should find and use proper class
+
+$x = Foo->new();
+ok ($x->round($Foo::accuracy),'a' x $Foo::accuracy);
+ok ($x->round(undef,$Foo::precision),'p' x $Foo::precision);
+ok ($x->bfround($Foo::precision),'p' x $Foo::precision);
+ok ($x->bround($Foo::accuracy),'a' x $Foo::accuracy);
+
+###############################################################################
+# find out whether _find_round_parameters is doing what's it's supposed to do
+
+$Math::BigInt::accuracy = undef;
+$Math::BigInt::precision = undef;
+$Math::BigInt::div_scale = 40;
+$Math::BigInt::round_mode = 'odd';
+
+$x = Math::BigInt->new(123);
+my @params = $x->_find_round_parameters();
+ok (scalar @params,1); # nothing to round
+
+@params = $x->_find_round_parameters(1);
+ok (scalar @params,4); # a=1
+ok ($params[0],$x); # self
+ok ($params[1],1); # a
+ok_undef ($params[2]); # p
+ok ($params[3],'odd'); # round_mode
+
+@params = $x->_find_round_parameters(undef,2);
+ok (scalar @params,4); # p=2
+ok ($params[0],$x); # self
+ok_undef ($params[1]); # a
+ok ($params[2],2); # p
+ok ($params[3],'odd'); # round_mode
+
+eval { @params = $x->_find_round_parameters(undef,2,'foo'); };
+ok ($@ =~ /^Unknown round mode 'foo'/,1);
+
+@params = $x->_find_round_parameters(undef,2,'+inf');
+ok (scalar @params,4); # p=2
+ok ($params[0],$x); # self
+ok_undef ($params[1]); # a
+ok ($params[2],2); # p
+ok ($params[3],'+inf'); # round_mode
+
+@params = $x->_find_round_parameters(2,-2,'+inf');
+ok (scalar @params,4); # p=2
+ok ($params[0],$x); # self
+ok ($params[1],2); # a
+ok ($params[2],-2); # p
+ok ($params[3],'+inf'); # round_mode
+
# all done
###############################################################################
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ unshift @INC, '../lib'; # for running manually
+ my $location = $0; $location =~ s/subclass.t//;
+ unshift @INC, $location; # to locate the testing files
+ #chdir 't' if -d 't';
+ plan tests => 1277;
+ }
+
+use Math::BigInt;
+use Math::Subclass;
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+$class = "Math::Subclass";
+
+require 'bigfltpm.inc'; # perform same tests as bigfltpm
+
+# Now do custom tests for Subclass itself
+my $ms = new Math::Subclass 23;
+print "# Missing custom attribute \$ms->{_custom}" if !ok (1, $ms->{_custom});
+
+use Math::BigFloat;
+
+my $bf = new Math::BigFloat 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});
+print "# Wrong class: ref(\$ms) was ".ref($ms) if !ok ($class, ref($ms));
projects / p5sagit/p5-mst-13.2.git / commitdiff