This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Math-BigInt v1.49 released
authorTels <nospam-abuse@bloodgate.com>
Tue, 8 Jan 2002 03:09:34 +0000 (04:09 +0100)
committerAbhijit Menon-Sen <ams@wiw.org>
Tue, 8 Jan 2002 03:38:40 +0000 (03:38 +0000)
p4raw-id: //depot/perl@14131

20 files changed:
MANIFEST
lib/Math/BigFloat.pm
lib/Math/BigInt.pm
lib/Math/BigInt/Calc.pm
lib/Math/BigInt/t/bare_mbi.t
lib/Math/BigInt/t/bigfltpm.inc
lib/Math/BigInt/t/bigfltpm.t
lib/Math/BigInt/t/bigintc.t
lib/Math/BigInt/t/bigintpm.inc
lib/Math/BigInt/t/bigintpm.t
lib/Math/BigInt/t/mbimbf.inc [new file with mode: 0644]
lib/Math/BigInt/t/mbimbf.t
lib/Math/BigInt/t/require.t [new file with mode: 0644]
lib/Math/BigInt/t/sub_mbf.t
lib/Math/BigInt/t/sub_mbi.t
lib/Math/BigInt/t/sub_mif.t [new file with mode: 0644]
lib/Math/BigInt/t/use.t [new file with mode: 0644]
t/lib/Math/BigFloat/Subclass.pm
t/lib/Math/BigInt/BareCalc.pm
t/lib/Math/BigInt/Subclass.pm

index deaa26a..1f53d85 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1084,10 +1084,14 @@ 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.inc Shared tests for bigintpm.t and sub_mbi.t
 lib/Math/BigInt/t/bigintpm.t   See if BigInt.pm works
+lib/Math/BigInt/t/require.t    Test if require Math::BigInt works
+lib/Math/BigInt/t/use.t                Test if use Math::BigInt(); works
 lib/Math/BigInt/t/calling.t    Test calling conventions
 lib/Math/BigInt/t/mbimbf.t     BigInt/BigFloat accuracy, precicion and fallback, round_mode
+lib/Math/BigInt/t/mbimbf.inc   Actual BigInt/BigFloat accuracy, precicion and fallback, round_mode tests
 lib/Math/BigInt/t/sub_mbf.t    Empty subclass test of BigFloat
 lib/Math/BigInt/t/sub_mbi.t    Empty subclass test of BigInt
+lib/Math/BigInt/t/sub_mif.t    Test A & P with subclasses using mbimbf.inc
 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
index a258777..92e53b3 100644 (file)
 
 package Math::BigFloat;
 
-$VERSION = '1.26';
+$VERSION = '1.27';
 require 5.005;
 use Exporter;
 use Math::BigInt qw/objectify/;
 @ISA =       qw( Exporter Math::BigInt);
-#@EXPORT_OK = qw( 
-#                bcmp 
-#                badd bmul bdiv bmod bnorm bsub
-#              bgcd blcm bround bfround
-#              bpow bnan bzero bfloor bceil 
-#              bacmp bstr binc bdec binf
-#              is_odd is_even is_nan is_inf is_positive is_negative
-#              is_zero is_one sign
-#               ); 
 
 use strict;
 use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
@@ -71,10 +62,10 @@ BEGIN { tie $rnd_mode, 'Math::BigFloat'; }
   # valid method aliases for AUTOLOAD
   my %methods = map { $_ => 1 }  
    qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
-        fint facmp fcmp fzero fnan finf finc fdec
-       fceil ffloor frsft flsft fone
+        fint facmp fcmp fzero fnan finf finc fdec flog
+       fceil ffloor frsft flsft fone flog
       /;
-  # valid method's that need to be hand-ed up (for AUTOLOAD)
+  # valid method's that can 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 fneg fabs babs fnot
@@ -94,13 +85,12 @@ sub new
   # _m: mantissa
   # sign  => sign (+/-), or "NaN"
 
-  my $class = shift;
+  my ($class,$wanted,@r) = @_;
  
-  my $wanted = shift; # avoid numify call by not using || here
-  return $class->bzero() if !defined $wanted;      # default to 0
-  return $wanted->copy() if ref($wanted) eq $class;
+  # avoid numify-calls by not using || on $wanted!
+  return $class->bzero() if !defined $wanted;  # default to 0
+  return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
 
-  my $round = shift; $round = 0 if !defined $round; # no rounding as default
   my $self = {}; bless $self, $class;
   # shortcut for bigints and its subclasses
   if ((ref($wanted)) && (ref($wanted) ne $class))
@@ -133,18 +123,15 @@ sub new
   else
     {
     # make integer from mantissa by adjusting exp, then convert to bigint
-    $self->{_e} = Math::BigInt->new("$$es$$ev");       # exponent
-    $self->{_m} = Math::BigInt->new("$$miv$$mfv");     # create mantissa
+    # undef,undef to signal MBI that we don't need no bloody rounding
+    $self->{_e} = Math::BigInt->new("$$es$$ev",undef,undef);   # exponent
+    $self->{_m} = Math::BigInt->new("$$miv$$mfv",undef,undef);         # create mant.
     # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
     $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;            
     $self->{sign} = $$mis;
     }
-  #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,$class->round_mode)
-   if defined $accuracy || defined $precision;
-  return $self;
+  # print "mbf new ",join(' ',@r),"\n";
+  $self->bnorm()->round(@r);           # first normalize, then round
   }
 
 sub bnan
@@ -159,8 +146,8 @@ sub bnan
   $self->{_m} = Math::BigInt->bzero();
   $self->{_e} = Math::BigInt->bzero();
   $self->{sign} = $nan;
-  ($self->{_a},$self->{_p}) = @_ if @_ > 0;
-  return $self;
+  $self->{_a} = undef; $self->{_p} = undef;
+  $self;
   }
 
 sub binf
@@ -177,8 +164,8 @@ sub binf
   $self->{_m} = Math::BigInt->bzero();
   $self->{_e} = Math::BigInt->bzero();
   $self->{sign} = $sign.'inf';
-  ($self->{_a},$self->{_p}) = @_ if @_ > 0;
-  return $self;
+  $self->{_a} = undef; $self->{_p} = undef;
+  $self;
   }
 
 sub bone
@@ -195,7 +182,13 @@ sub bone
   $self->{_m} = Math::BigInt->bone();
   $self->{_e} = Math::BigInt->bzero();
   $self->{sign} = $sign;
-  ($self->{_a},$self->{_p}) = @_ if @_ > 0;
+  if (@_ > 0)
+    {
+    $self->{_a} = $_[0]
+     if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
+    $self->{_p} = $_[1]
+     if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+    }
   return $self;
   }
 
@@ -211,7 +204,13 @@ sub bzero
   $self->{_m} = Math::BigInt->bzero();
   $self->{_e} = Math::BigInt->bone();
   $self->{sign} = '+';
-  ($self->{_a},$self->{_p}) = @_ if @_ > 0;
+  if (@_ > 0)
+    {
+    $self->{_a} = $_[0]
+     if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
+    $self->{_p} = $_[1]
+     if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+    }
   return $self;
   }
 
@@ -243,10 +242,6 @@ sub bstr
     $es = $x->{_m}->bstr();
     $len = CORE::length($es);
     if (!$x->{_e}->is_zero())
-#      {
-#      $es = $x->{sign}.$es if $x->{sign} eq '-'; 
-#      }
-#    else
       {
       if ($x->{_e}->sign() eq '-')
         {
@@ -277,14 +272,12 @@ sub bstr
     # 123400 => 6, 0.1234 => 4, 0.001234 => 4
     my $zeros = $x->{_a} - $cad;               # cad == 0 => 12340
     $zeros = $x->{_a} - $len if $cad != $len;
-    #print "acc padd $x->{_a} $zeros (len $len cad $cad)\n";
     $es .= $dot.'0' x $zeros if $zeros > 0;
     }
   elsif ($x->{_p} || 0 < 0)
     {
     # 123400 => 6, 0.1234 => 4, 0.001234 => 6
     my $zeros = -$x->{_p} + $cad;
-    #print "pre padd $x->{_p} $zeros (len $len cad $cad)\n";
     $es .= $dot.'0' x $zeros if $zeros > 0;
     }
   return $es;
@@ -477,36 +470,22 @@ sub badd
   my $add = $y->{_m}->copy();
   if ($e < 0)
     {
-    # print "e < 0\n";
-    #print "\$x->{_m}: $x->{_m} ";
-    #print "\$x->{_e}: $x->{_e}\n";
     my $e1 = $e->copy()->babs();
     $x->{_m} *= (10 ** $e1);
     $x->{_e} += $e;                    # need the sign of e
-    #$x->{_m} += $y->{_m};
-    #print "\$x->{_m}: $x->{_m} ";
-    #print "\$x->{_e}: $x->{_e}\n";
     }
   elsif ($e > 0)
     {
-    # print "e > 0\n";
-    #print "\$x->{_m}: $x->{_m} \$y->{_m}: $y->{_m} \$e: $e ",ref($e),"\n";
     $add *= (10 ** $e);
-    #$x->{_m} += $y->{_m} * (10 ** $e);
-    #print "\$x->{_m}: $x->{_m}\n";
     }
-  # else: both e are same, so leave them
-  #print "badd $x->{sign}$x->{_m} +  $y->{sign}$add\n";
-  # fiddle with signs
-  $x->{_m}->{sign} = $x->{sign};
+  # else: both e are the same, so just leave them
+  $x->{_m}->{sign} = $x->{sign};               # fiddle with signs
   $add->{sign} = $y->{sign};
-  # finally do add/sub
-  $x->{_m} += $add;
-  # re-adjust signs
-  $x->{sign} = $x->{_m}->{sign};
-  $x->{_m}->{sign} = '+';
-  #$x->bnorm();                                # delete trailing zeros
-  return $x->round($a,$p,$r,$y);
+  $x->{_m} += $add;                            # finally do add/sub
+  $x->{sign} = $x->{_m}->{sign};               # re-adjust signs
+  $x->{_m}->{sign} = '+';                      # mantissa always positiv
+  # delete trailing zeros, then round
+  return $x->bnorm()->round($a,$p,$r,$y);
   }
 
 sub bsub 
@@ -590,6 +569,50 @@ sub bdec
   $x->badd($self->bone('-'),$a,$p,$r);         # does round 
   } 
 
+sub blog
+  {
+  my ($self,$x,$base,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
+
+  # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
+
+  # u = x-1, v = x +1
+  #              _                               _
+  # taylor:     |    u    1   u^3   1   u^5       |
+  # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
+  #             |_   v    3    v    5   v        _|
+
+  return $x->bzero(@r) if $x->is_one();
+  return $x->bone(@r) if $x->bcmp($base) == 0;
+
+  my $d = $r[0] || $self->accuracy() || 40;
+  $d += 2;                                     # 2 more for rounding
+  my $u = $x->copy(); $u->bdec();
+  my $v = $x->copy(); $v->binc();
+
+  $x->bdec()->bdiv($v,$d);                     # first term: u/v
+
+  $u *= $u; $v *= $v;
+  my $below = $v->copy()->bmul($v);
+  my $over = $u->copy()->bmul($u);
+  my $factor = $self->new(3); my $two = $self->new(2);
+
+  my $diff = $self->bone();
+  my $limit = $self->new("1E-". ($d-1)); my $last;
+  # print "diff $diff limit $limit\n";
+  while ($diff > $limit)
+    {
+    print "$x $over $below $factor\n";
+    $diff = $x->copy()->bsub($last)->babs();
+    print "diff $diff $limit\n";
+    $last = $x->copy();
+    $x += $over->copy()->bdiv($below->copy()->bmul($factor),$d);
+    $over *= $u; $below *= $v; $factor->badd($two);
+    }
+  $x->bmul($two);
+  return $x->round(@r);
+  }
+
 sub blcm 
   { 
   # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
@@ -692,7 +715,6 @@ sub bdiv
   # (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$/;
@@ -719,8 +741,8 @@ sub bdiv
   if (scalar @params == 1)
     {
     # simulate old behaviour
-    $scale = $self->div_scale()+1;     # at least one more for proper round
     $params[1] = $self->div_scale();   # and round to it as accuracy
+    $scale = $params[1]+4;             # at least four more for proper round
     $params[3] = $r;                   # round mode by caller or undef
     $fallback = 1;                     # to clear a/p afterwards
     }
@@ -756,7 +778,7 @@ sub bdiv
   # shortcut to not run trough _find_round_parameters again
   if (defined $params[1])
     {
-    $x->bround($params[1],undef,$params[3]);   # then round accordingly
+    $x->bround($params[1],$params[3]);         # then round accordingly
     }
   else
     {
@@ -795,11 +817,75 @@ sub bmod
   # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder 
   my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
 
-  return $x->bnan() if ($x->is_nan() || $y->is_nan() || $y->is_zero());
-  return $x->bzero() if $y->is_one();
+  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+    {
+    my ($d,$re) = $self->SUPER::_div_inf($x,$y);
+    return $re->round($a,$p,$r,$y);
+    } 
+  return $x->bnan() if $x->is_zero() && $y->is_zero();
+  return $x if $y->is_zero();
+  return $x->bnan() if $x->is_nan() || $y->is_nan();
+  return $x->bzero() if $y->is_one() || $x->is_zero();
 
-  # XXX tels: not done yet
-  return $x->round($a,$p,$r,$y);
+  # inf handling is missing here
+  my $cmp = $x->bacmp($y);                     # equal or $x < $y?
+  return $x->bzero($a,$p) if $cmp == 0;                # $x == $y => result 0
+
+  # only $y of the operands negative? 
+  my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign};
+
+  $x->{sign} = $y->{sign};                             # calc sign first
+  return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0; # $x < $y => result $x
+  
+  my $ym = $y->{_m}->copy();
+  
+  # 2e1 => 20
+  $ym->blsft($y->{_e},10) if $y->{_e}->{sign} eq '+' && !$y->{_e}->is_zero();
+  # if $y has digits after dot
+  my $shifty = 0;                      # correct _e of $x by this
+  if ($y->{_e}->{sign} eq '-')         # has digits after dot
+    {
+    # 123 % 2.5 => 1230 % 25 => 5 => 0.5
+    $shifty = $y->{_e}->copy()->babs();        # no more digits after dot
+    $x->blsft($shifty,10);             # 123 => 1230, $y->{_m} is already 25
+    }
+  # $ym is now mantissa of $y based on exponent 0
+  
+  my $shiftx = 0;                      # correct _e of $x by this
+  if ($x->{_e}->{sign} eq '-')         # has digits after dot
+    {
+    # 123.4 % 20 => 1234 % 200
+    $shiftx = $x->{_e}->copy()->babs();        # no more digits after dot
+    $ym->blsft($shiftx,10);
+    }
+  # 123e1 % 20 => 1230 % 20
+  if ($x->{_e}->{sign} eq '+' && !$x->{_e}->is_zero())
+    {
+    $x->{_m}->blsft($x->{_e},10);
+    }
+  $x->{_e} = Math::BigInt->bzero() unless $x->{_e}->is_zero();
+  
+  $x->{_e}->bsub($shiftx) if $shiftx != 0;
+  $x->{_e}->bsub($shifty) if $shifty != 0;
+  
+  # now mantissas are equalized, exponent of $x is adjusted, so calc result
+  $x->{_m}->bmod($ym);
+
+  $x->{sign} = '+' if $x->{_m}->is_zero();             # fix sign for -0
+  $x->bnorm();
+
+  if ($neg != 0)       # one of them negative => correct in place
+    {
+    my $r = $y - $x;
+    $x->{_m} = $r->{_m};
+    $x->{_e} = $r->{_e};
+    $x->{sign} = '+' if $x->{_m}->is_zero();           # fix sign for -0
+    $x->bnorm();
+    }
+
+  $x->round($a,$p,$r,$y);      # round and return
   }
 
 sub bsqrt
@@ -812,16 +898,36 @@ sub bsqrt
   return $x if $x->{sign} eq '+inf';                             # +inf
   return $x if $x->is_zero() || $x->is_one();
 
-  # we need to limit the accuracy to protect against overflow (ignore $p)
-  my ($scale) = $x->_scale_a($self->accuracy(),$self->round_mode,$a,$r); 
+  # we need to limit the accuracy to protect against overflow
   my $fallback = 0;
-  if (!defined $scale)
+  my $scale = 0;
+  my @params = $x->_find_round_parameters($a,$p,$r);
+
+  # no rounding at all, so must use fallback
+  if (scalar @params == 1)
     {
     # simulate old behaviour
-    $scale = $self->div_scale()+1;     # one more for proper riund
-    $a = $self->div_scale();           # and round to it
+    $params[1] = $self->div_scale();   # and round to it as accuracy
+    $scale = $params[1]+4;             # at least four more for proper round
+    $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
+    }
+
+  # when user set globals, they would interfere with our calculation, so
+  # disable then and later re-enable them
+  no strict 'refs';
+  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
+  $abr = "$self\::precision"; my $pb = $$abr; $$abr = undef;
+  # we also need to disable any set A or P on $x (_find_round_parameters took
+  # them already into account), since these would interfere, too
+  delete $x->{_a}; delete $x->{_p};
+
   my $xas = $x->as_number();
   my $gs = $xas->copy()->bsqrt();      # some guess
   if (($x->{_e}->{sign} ne '-')                # guess can't be accurate if there are
@@ -829,51 +935,67 @@ sub bsqrt
    && ($xas->bcmp($gs * $gs) == 0))    # guess hit the nail on the head?
     {
     # exact result
-    $x->{_m} = $gs;
-    # leave alone if _e is already right
-    $x->{_e} = Math::BigInt->bzero();
-    return $x->bnorm()->round($a,$p,$r)
+    $x->{_m} = $gs; $x->{_e} = Math::BigInt->bzero(); $x->bnorm();
+    # shortcut to not run trough _find_round_parameters again
+    if (defined $params[1])
+      {
+      $x->bround($params[1],$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;
+      }
+    return $x;
     }
-  $gs = $self->new( $gs );
+  $gs = $self->new( $gs );             # BigInt to BigFloat
 
   my $lx = $x->{_m}->length();
   $scale = $lx if $scale < $lx;
   my $e = $self->new("1E-$scale");     # make test variable
   return $x->bnan() if $e->sign() eq 'NaN';
 
-  # start with some reasonable guess
-# $lx = $lx+$x->{_e};
-#  $lx = $lx / 2;
-#  $lx = 1 if $lx < 1;
- # my $gs = Math::BigFloat->new("1E$lx");      
-
-#  print "first guess: $gs (x $x) scale $scale\n";
-#  # use BigInt:sqrt as reasonabe guess
-#  print "second guess: $gs (x $x) scale $scale\n";
-
-  my $diff = $e;
   my $y = $x->copy();
   my $two = $self->new(2);
+  my $diff = $e;
   # promote BigInts and it's subclasses (except when already a BigFloat)
   $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
+
   my $rem;
 #  my $steps = 0;
   while ($diff >= $e)
     {
-    # return $x->bnan() if $gs->is_zero();
+#    return $x->bnan() if $gs->is_zero();
 
-    $x = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale);
-    $diff = $x->copy()->bsub($gs)->babs();
-    $gs = $x->copy();
+    $rem = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale);
+    $diff = $rem->copy()->bsub($gs)->babs();
+    $gs = $rem->copy();
 #    $steps++;
     }
 #  print "steps $steps\n";
-  $x->round($a,$p,$r);
+  # copy over to modify $x
+  $x->{_m} = $rem->{_m}; $x->{_e} = $rem->{_e};
+  
+  # shortcut to not run trough _find_round_parameters again
+  if (defined $params[1])
+    {
+    $x->bround($params[1],$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;
     }
+  # restore globals
+  ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
   $x;
   }
 
@@ -931,7 +1053,12 @@ sub bfround
   return $x if !defined $scale;                        # no-op
 
   # never round a 0, +-inf, NaN
-  return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
+  if ($x->is_zero())
+    {
+    $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
+    return $x; 
+    }
+  return $x if $x->{sign} !~ /^[+-]$/;
   # print "MBF bfround $x to scale $scale mode $mode\n";
 
   # don't round if x already has lower precision
@@ -1028,33 +1155,33 @@ sub bround
 
   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
-  return $x if ($scale <= 0);          
-  # never round a 0, +-inf, NaN
-  return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();        
+  # scale < 0 makes no sense
+  # never round a +-inf, NaN
+  return $x if ($scale < 0) || $x->{sign} !~ /^[+-]$/;
 
-  # if $e longer than $m, we have 0.0000xxxyyy style number, and must
-  # subtract the delta from scale, to simulate keeping the zeros
-  # -5 +5 => 1; -10 +5 => -4
-  my $delta = $x->{_e} + $x->{_m}->length() + 1; 
-  
-  # if we should keep more digits than the mantissa has, do nothing
-  return $x if $x->{_m}->length() <= $scale;
+  # 1: $scale == 0 => keep all digits
+  # 2: never round a 0
+  # 3: if we should keep more digits than the mantissa has, do nothing
+  if ($scale == 0 || $x->is_zero() || $x->{_m}->length() <= $scale)
+    {
+    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
+    return $x; 
+    }
 
   # pass sign to bround for '+inf' and '-inf' rounding modes
   $x->{_m}->{sign} = $x->{sign};
   $x->{_m}->bround($scale,$mode);      # round mantissa
   $x->{_m}->{sign} = '+';              # fix sign back
+  # $x->{_m}->{_a} = undef; $x->{_m}->{_p} = undef;
   $x->{_a} = $scale;                   # remember rounding
   $x->{_p} = undef;                    # and clear P
   $x->bnorm();                         # del trailing zeros gen. by bround()
@@ -1076,7 +1203,7 @@ sub bfloor
     $x->{_e}->bzero();
     $x-- if $x->{sign} eq '-';
     }
-  return $x->round($a,$p,$r);
+  $x->round($a,$p,$r);
   }
 
 sub bceil
@@ -1094,7 +1221,7 @@ sub bceil
     $x->{_e}->bzero();
     $x++ if $x->{sign} eq '+';
     }
-  return $x->round($a,$p,$r);
+  $x->round($a,$p,$r);
   }
 
 sub brsft
@@ -1186,7 +1313,7 @@ sub mantissa
   my $m = $x->{_m}->copy();            # faster than going via bstr()
   $m->bneg() if $x->{sign} eq '-';
 
-  return $m;
+  $m;
   }
 
 sub parts
@@ -1247,8 +1374,8 @@ sub bnorm
   # '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, so dont call it
-  }
+  $x;                                  # MBI bnorm is no-op, so dont call it
+  } 
  
 ##############################################################################
 # internal calculation routines
@@ -1275,7 +1402,7 @@ sub as_number
     $z->blsft($x->{_e},10);
     }
   $z->{sign} = $x->{sign};
-  return $z;
+  $z;
   }
 
 sub length
@@ -1293,7 +1420,7 @@ sub length
     $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-';
     return ($len,$t);
     }
-  return $len;
+  $len;
   }
 
 1;
@@ -1351,6 +1478,9 @@ Math::BigFloat - Arbitrary size floating point math package
   $x->brsft($y);               # right shift 
                                # return (quo,rem) or quo if scalar
   
+  $x->blog($base);             # logarithm of $x, base defaults to e
+                               # (other bases than e not supported yet)
+  
   $x->band($y);                        # bit-wise and
   $x->bior($y);                        # bit-wise inclusive or
   $x->bxor($y);                        # bit-wise exclusive or
index 354bc71..516406b 100644 (file)
@@ -14,21 +14,10 @@ package Math::BigInt;
 my $class = "Math::BigInt";
 require 5.005;
 
-$VERSION = '1.48';
+$VERSION = '1.49';
 use Exporter;
 @ISA =       qw( Exporter );
-# no longer export stuff (it doesn't work with subclasses anyway)
-# bneg babs bcmp badd bmul bdiv bmod bnorm bsub
-#                 bgcd blcm bround 
-#                 blsft brsft band bior bxor bnot bpow bnan bzero 
-#                 bacmp bstr bsstr binc bdec binf bfloor bceil
-#                 is_odd is_even is_zero is_one is_nan is_inf sign
-#               is_positive is_negative
-#               length as_number
-@EXPORT_OK = qw(
-                objectify _swap
-                bgcd blcm
-               ); 
+@EXPORT_OK = qw( objectify _swap bgcd blcm); 
 use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
 use strict;
 
@@ -78,6 +67,7 @@ use overload
                $_[1] cmp $_[0]->bstr() :
                $_[0]->bstr() cmp $_[1] },
 
+'log'  =>      sub { $_[0]->copy()->blog(); }, 
 'int'  =>      sub { $_[0]->copy(); }, 
 'neg'  =>      sub { $_[0]->copy()->bneg(); }, 
 'abs'  =>      sub { $_[0]->copy()->babs(); },
@@ -123,6 +113,7 @@ my $NaNOK=1;                                # are NaNs ok?
 my $nan = 'NaN';                       # constants for easier life
 
 my $CALC = 'Math::BigInt::Calc';       # module to do low level math
+my $IMPORT = 0;                                # did import() yet?
 sub _core_lib () { return $CALC; }     # for test suite
 
 $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
@@ -319,7 +310,7 @@ sub copy
       }
     else # normal ref
       {
-      my $xk = $x->{$k};       
+      my $xk = $x->{$k};
       if ($xk->can('copy'))
         {
        $self->{$k} = $xk->copy();
@@ -342,12 +333,14 @@ sub new
   # cause costly overloaded code to be called. The only allowed ops are
   # ref() and defined.
 
-  my $class = shift;
+  my ($class,$wanted,$a,$p,$r) = @_;
  
-  my $wanted = shift; # avoid numify call by not using || here
-  return $class->bzero() if !defined $wanted;  # default to 0
-  return $class->copy($wanted) if ref($wanted);
+  # avoid numify-calls by not using || on $wanted!
+  return $class->bzero($a,$p) if !defined $wanted;     # default to 0
+  return $class->copy($wanted,$a,$p,$r) if ref($wanted);
 
+  $class->import() if $IMPORT == 0;            # make require work
+  
   my $self = {}; bless $self, $class;
   # handle '+inf', '-inf' first
   if ($wanted =~ /^[+-]?inf$/)
@@ -415,8 +408,9 @@ sub new
   $self->{sign} = '+' if $$miv eq '0';                 # normalize -0 => +0
   $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
   # if any of the globals is set, use them to round and store them inside $self
-  $self->round($accuracy,$precision,$round_mode)
-   if defined $accuracy || defined $precision;
+  # do not round for new($x,undef,undef) since that is used by MBF to signal
+  # no rounding
+  $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
   return $self;
   }
 
@@ -429,6 +423,7 @@ sub bnan
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  $self->import() if $IMPORT == 0;             # make require work
   return if $self->modify('bnan');
   $self->{value} = $CALC->_zero();
   $self->{sign} = $nan;
@@ -447,6 +442,7 @@ sub binf
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  $self->import() if $IMPORT == 0;             # make require work
   return if $self->modify('binf');
   $self->{value} = $CALC->_zero();
   $self->{sign} = $sign.'inf';
@@ -464,10 +460,17 @@ sub bzero
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  $self->import() if $IMPORT == 0;             # make require work
   return if $self->modify('bzero');
   $self->{value} = $CALC->_zero();
   $self->{sign} = '+';
-  ($self->{_a},$self->{_p}) = @_;              # take over requested rounding
+  if (@_ > 0)
+    {
+    $self->{_a} = $_[0]
+     if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
+    $self->{_p} = $_[1]
+     if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+    }
   return $self;
   }
 
@@ -483,10 +486,17 @@ sub bone
     {
     my $c = $self; $self = {}; bless $self, $c;
     }
+  $self->import() if $IMPORT == 0;             # make require work
   return if $self->modify('bone');
   $self->{value} = $CALC->_one();
   $self->{sign} = $sign;
-  ($self->{_a},$self->{_p}) = @_;              # take over requested rounding
+  if (@_ > 0)
+    {
+    $self->{_a} = $_[0]
+     if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a});
+    $self->{_p} = $_[1]
+     if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p});
+    }
   return $self;
   }
 
@@ -553,84 +563,119 @@ 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.
-  # The result's A or P are set by the rounding, but not inspected beforehand
-  # (aka only the arguments enter into it). This works because the given
-  # 'first' argument is both the result and true first argument with unchanged
-  # A and P settings.
-  # This does not yet handle $x with A, and $y with P (which should be an
-  # error).
+
+  # This procedure finds the round parameters, but it is for speed reasons
+  # duplicated in round. Otherwise, it is tested by the testsuite and used
+  # by fdiv().
+  
   my ($self,$a,$p,$r,@args) = @_;
   # $a accuracy, if given by caller
   # $p precision, if given by caller
   # $r round_mode, if given by caller
   # @args all 'other' arguments (0 for unary, 1 for binary ops)
 
-  # $self = new($self) unless ref($self);      # if not object, make one
-        
   # leave bigfloat parts alone
   return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
 
-  unshift @args,$self;                         # add 'first' argument
   my $c = ref($self);                          # find out class of argument(s)
   no strict 'refs';
 
   # now pick $a or $p, but only if we have got "arguments"
-  if ((!defined $a) && (!defined $p) && (@args > 0))
+  if (!defined $a)
     {
-    foreach (@args)
+    foreach ($self,@args)
       {
       # take the defined one, or if both defined, the one that is smaller
       $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
       }
-    if (!defined $a)           # if it still is not defined, take p
-      {
-      foreach (@args)
-        {
-        # take the defined one, or if both defined, the one that is bigger
-        # -2 > -3, and 3 > 2
-        $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
-        }
-      # if none defined, use globals (#2)
-      if (!defined $p) 
-        {
-        my $z = "$c\::accuracy"; my $a = $$z; 
-        if (!defined $a)
-          {
-          $z = "$c\::precision"; $p = $$z;
-          }
-        }
-      } # endif !$a
-    } # endif !$a || !$P && args > 0
-  my @params = ($self);
-  if (defined $a || defined $p)
+    }
+  if (!defined $p)
     {
-    $r = $r || ${"$c\::round_mode"};
-    die "Unknown round mode '$r'"
-     if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
-    push @params, ($a,$p,$r);
+    # even if $a is defined, take $p, to signal error for both defined
+    foreach ($self,@args)
+      {
+      # take the defined one, or if both defined, the one that is bigger
+      # -2 > -3, and 3 > 2
+      $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+      }
     }
-  return @params;
+  # if still none defined, use globals (#2)
+  $a = ${"$c\::accuracy"} unless defined $a;
+  $p = ${"$c\::precision"} unless defined $p;
+  # no rounding today? 
+  return ($self) unless defined $a || defined $p;              # early out
+
+  # set A and set P is an fatal error
+  return ($self->bnan()) if defined $a && defined $p;
+
+  $r = ${"$c\::round_mode"} unless defined $r;
+  die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+  return ($self,$a,$p,$r);
   }
 
 sub round
   {
-  # round $self according to given parameters, or given second argument's
+  # 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 $params[1])
+  # for speed reasons, _find_round_parameters is embeded here:
+
+  my ($self,$a,$p,$r,@args) = @_;
+  # $a accuracy, if given by caller
+  # $p precision, if given by caller
+  # $r round_mode, if given by caller
+  # @args all 'other' arguments (0 for unary, 1 for binary ops)
+
+  # leave bigfloat parts alone
+  return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+
+  my $c = ref($self);                          # find out class of argument(s)
+  no strict 'refs';
+
+  # now pick $a or $p, but only if we have got "arguments"
+  if (!defined $a)
     {
-    $self->bround($params[1],$params[3]);
+    foreach ($self,@args)
+      {
+      # take the defined one, or if both defined, the one that is smaller
+      $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+      }
     }
-  else
+  if (!defined $p)
+    {
+    # even if $a is defined, take $p, to signal error for both defined
+    foreach ($self,@args)
+      {
+      # take the defined one, or if both defined, the one that is bigger
+      # -2 > -3, and 3 > 2
+      $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+      }
+    }
+  # if still none defined, use globals (#2)
+  $a = ${"$c\::accuracy"} unless defined $a;
+  $p = ${"$c\::precision"} unless defined $p;
+  # no rounding today? 
+  return $self unless defined $a || defined $p;                # early out
+
+  # set A and set P is an fatal error
+  return $self->bnan() if defined $a && defined $p;
+
+  $r = ${"$c\::round_mode"} unless defined $r;
+  die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+
+  # now round, by calling either fround or ffround:
+  if (defined $a)
+    {
+    $self->bround($a,$r) if !defined $self->{_a} || $self->{_a} >= $a;
+    }
+  else # both can't be undefined due to early out
     {
-    $self->bfround($params[2],$params[3]);
+    $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p;
     }
-  return $self->bnorm();                       # after round, normalize
+  $self->bnorm();                      # after round, normalize
   }
 
 sub bnorm
@@ -728,10 +773,11 @@ sub badd
   {
   # add second arg (BINT or string) to first (BINT) (modifies first)
   # return result as BINT
-  my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+  my ($self,$x,$y,@r) = objectify(2,@_);
 
   return $x if $x->modify('badd');
 
+  $r[3] = $y;                          # no push!
   # inf and NaN handling
   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
     {
@@ -741,7 +787,7 @@ sub badd
    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
       {
       # + and + => +, - and - => -, + and - => 0, - and + => 0
-      return $x->bzero() if $x->{sign} ne $y->{sign};
+      return $x->bzero(@r) if $x->{sign} ne $y->{sign};
       return $x;
       }
     # +-inf + something => +inf
@@ -750,15 +796,14 @@ sub badd
     return $x;
     }
     
-  my @bn = ($a,$p,$r,$y);                      # make array for round calls
   # speed: no add for 0+y or x+0
-  return $x->round(@bn) if $y->is_zero();                      # x+0
+  return $x->round(@r) if $y->is_zero();                       # x+0
   if ($x->is_zero())                                           # 0+y
     {
     # make copy, clobbering up x
     $x->{value} = $CALC->_copy($y->{value});
     $x->{sign} = $y->{sign} || $nan;
-    return $x->round(@bn);
+    return $x->round(@r);
     }
 
   my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
@@ -791,7 +836,7 @@ sub badd
       $x->{sign} = $sx;
       }
     }
-  return $x->round(@bn);
+  $x->round(@r);
   }
 
 sub bsub 
@@ -808,7 +853,7 @@ sub bsub
     $x->badd($y,$a,$p,$r);     # badd does not leave internal zeros
     $y->{sign} =~ tr/+\-/-+/;  # refix $y (does nothing for NaN)
     }
-  $x;                          # already rounded by badd()
+  $x;                          # already rounded by badd() or no round necc.
   }
 
 sub binc
@@ -829,7 +874,7 @@ sub binc
     return $x->round($a,$p,$r);
     }
   # inf, nan handling etc
-  $x->badd($self->__one(),$a,$p,$r);           # does round
+  $x->badd($self->__one(),$a,$p,$r);           # badd does round
   }
 
 sub bdec
@@ -854,9 +899,17 @@ sub bdec
     return $x->round($a,$p,$r);
     }
   # inf, nan handling etc
-  $x->badd($self->__one('-'),$a,$p,$r);                        # does round
+  $x->badd($self->__one('-'),$a,$p,$r);                        # badd does round
   } 
 
+sub blog
+  {
+  # not implemented yet
+  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+  return $x->bnan();
+  }
 sub blcm 
   { 
   # (BINT or num_str, BINT or num_str) return BINT
@@ -915,8 +968,7 @@ sub bnot
   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
-  return $x->round($a,$p,$r);
+  $x->bneg()->bdec();                  # bdec already does round
   }
 
 sub is_zero
@@ -1015,13 +1067,16 @@ sub bmul
   { 
   # multiply two numbers -- stolen from Knuth Vol 2 pg 233
   # (BINT or num_str, BINT or num_str) return BINT
-  my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+  my ($self,$x,$y,@r) = objectify(2,@_);
   
   return $x if $x->modify('bmul');
+
+  $r[3] = $y;                          # no push here
   return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
   # handle result = 0
-  return $x if $x->is_zero();
-  return $x->bzero() if $y->is_zero();
+  return $x->round(@r) if $x->is_zero();
+  return $x->bzero()->round(@r) if $y->is_zero();
   # inf handling
   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
     {
@@ -1036,7 +1091,7 @@ sub bmul
   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
 
   $x->{value} = $CALC->_mul($x->{value},$y->{value});  # do actual math
-  return $x->round($a,$p,$r,$y);
+  return $x->round(@r);
   }
 
 sub _div_inf
@@ -1095,30 +1150,33 @@ sub bdiv
   {
   # (dividend: BINT or num_str, divisor: BINT or num_str) return 
   # (BINT,BINT) (quo,rem) or BINT (only rem)
-  my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+  my ($self,$x,$y,@r) = objectify(2,@_);
 
   return $x if $x->modify('bdiv');
 
   return $self->_div_inf($x,$y)
    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
 
+  $r[3] = $y;                                  # no push!
+
   # 0 / something
-  return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
+  return
+   wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
  
   # Is $x in the interval [0, $y) ?
   my $cmp = $CALC->_acmp($x->{value},$y->{value});
   if (($cmp < 0) and ($x->{sign} eq $y->{sign}))
     {
-    return $x->bzero() unless wantarray;
+    return $x->bzero()->round(@r) unless wantarray;
     my $t = $x->copy();      # make copy first, because $x->bzero() clobbers $x
-    return ($x->bzero(),$t);
+    return ($x->bzero()->round(@r),$t);
     }
   elsif ($cmp == 0)
     {
     # shortcut, both are the same, so set to +/- 1
     $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') ); 
     return $x unless wantarray;
-    return ($x,$self->bzero());
+    return ($x->round(@r),$self->bzero(@r));
     }
    
   # calc new sign and in case $y == +/- 1, return $x
@@ -1127,7 +1185,7 @@ sub bdiv
   # check for / +-1 (cant use $y->is_one due to '-'
   if ($CALC->_is_one($y->{value}))
     {
-    return wantarray ? ($x,$self->bzero()) : $x
+    return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r)
     }
 
   my $rem;
@@ -1136,7 +1194,7 @@ sub bdiv
     my $rem = $self->bzero(); 
     ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
     $x->{sign} = '+' if $CALC->_is_zero($x->{value});
-    $x->round($a,$p,$r,$y); 
+    $x->round(@r); 
     if (! $CALC->_is_zero($rem->{value}))
       {
       $rem->{sign} = $y->{sign};
@@ -1146,26 +1204,28 @@ sub bdiv
       {
       $rem->{sign} = '+';                      # dont leave -0
       }
-    $rem->round($a,$p,$r,$x,$y);
+    $rem->round(@r);
     return ($x,$rem);
     }
 
   $x->{value} = $CALC->_div($x->{value},$y->{value});
   $x->{sign} = '+' if $CALC->_is_zero($x->{value});
-  $x->round($a,$p,$r,$y); 
+  $x->round(@r); 
+  $x;
   }
 
 sub bmod 
   {
   # modulus (or remainder)
   # (BINT or num_str, BINT or num_str) return BINT
-  my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
-  
+  my ($self,$x,$y,@r) = objectify(2,@_);
   return $x if $x->modify('bmod');
+  $r[3] = $y;                                  # no push!
   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
     {
     my ($d,$r) = $self->_div_inf($x,$y);
-    return $r;
+    return $r->round(@r);
     }
 
   if ($CALC->can('_mod'))
@@ -1182,12 +1242,9 @@ sub bmod
       {
       $x->{sign} = '+';                                # dont leave -0
       }
+    return $x->round(@r);
     }
-  else
-    {
-    $x = (&bdiv($self,$x,$y))[1];              # slow way
-    }
-  $x->round($a,$p,$r);
+  $x = (&bdiv($self,$x,$y,@r))[1];             # slow way (also rounds)
   }
 
 sub bpow 
@@ -1195,29 +1252,30 @@ sub bpow
   # (BINT or num_str, BINT or num_str) return BINT
   # compute power of two numbers -- stolen from Knuth Vol 2 pg 233
   # modifies first argument
-  my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+  my ($self,$x,$y,@r) = objectify(2,@_);
 
   return $x if $x->modify('bpow');
  
+  $r[3] = $y;                                  # no push!
   return $x if $x->{sign} =~ /^[+-]inf$/;      # -inf/+inf ** x
   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
-  return $x->__one() if $y->is_zero();
-  return $x         if $x->is_one() || $y->is_one();
+  return $x->bone(@r) if $y->is_zero();
+  return $x->round(@r) if $x->is_one() || $y->is_one();
   if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
     {
     # if $x == -1 and odd/even y => +1/-1
-    return $y->is_odd() ? $x : $x->babs();
+    return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
     }
   # 1 ** -y => 1 / (1 ** |y|)
   # so do test for negative $y after above's clause
   return $x->bnan() if $y->{sign} eq '-';
-  return $x         if $x->is_zero();  # 0**y => 0 (if not y <= 0)
+  return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 
   if ($CALC->can('_pow'))
     {
     $x->{value} = $CALC->_pow($x->{value},$y->{value});
-    return $x->round($a,$p,$r);
+    return $x->round(@r);
     }
 
 # based on the assumption that shifting in base 10 is fast, and that mul
@@ -1247,7 +1305,7 @@ sub bpow
     $x->bmul($x);
     }
   $x->bmul($pow2) unless $pow2->is_one();
-  return $x->round($a,$p,$r);
+  return $x->round(@r);
   }
 
 sub blsft 
@@ -1447,7 +1505,6 @@ sub _trailing_zeros
 
   # if not: since we do not know underlying internal representation:
   my $es = "$x"; $es =~ /([0]*)$/;
   return 0 if !defined $1;     # no zeros
   return CORE::length("$1");   # as string, not as +0!
   }
@@ -1541,6 +1598,7 @@ sub bfround
   # no-op for BigInts if $n <= 0
   if ($scale <= 0)
     {
+    $x->{_a} = undef;                          # clear an eventual set A
     $x->{_p} = $scale; return $x;
     }
 
@@ -1560,7 +1618,6 @@ sub _scan_for_nonzero
   return 0 if $len == 1;               # '5' is trailed by invisible zeros
   my $follow = $pad - 1;
   return 0 if $follow > $len || $follow < 1;
-  #print "checking $x $r\n";
 
   # since we do not know underlying represention of $x, use decimal string
   #my $r = substr ($$xs,-$follow);
@@ -1583,20 +1640,24 @@ sub bround
   # no-op for $n == 0
   # 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($x->accuracy(),$x->round_mode(),@_);
-  return $x if !defined $scale;                # no-op
+  return $x if !defined $scale;                        # no-op
   
-  # print "MBI round: $x to $scale $mode\n";
-  return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
+  if ($x->is_zero() || $scale == 0)
+    {
+    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
+    return $x;
+    }
+  return $x if $x->{sign} !~ /^[+-]$/;         # inf, NaN
 
   # we have fewer digits than we want to scale to
   my $len = $x->length();
-  # 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
+    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
     return $x; 
     }
    
@@ -1606,19 +1667,15 @@ sub bround
   $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;
+  $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
 
  #  print "$pad $pl $$xs dr $digit_round da $digit_after\n";
 
@@ -1638,56 +1695,56 @@ sub bround
      ($mode eq '-inf') && ($x->{sign} eq '+')   ||
      ($mode eq 'zero')         # round down if zero, sign adjusted below
     );
-  # allow rounding one place left of mantissa
-  #print "$pad $len $scale\n";
-  # this is triggering warnings, and buggy for $scale < 0
-  #if (-$scale != $len)
-    {
-    # old code, depend on internal representation
-    # split mantissa at $pad and then pad with zeros
-    #my $s5 = int($pad / 5);
-    #my $i = 0;
-    #while ($i < $s5)
-    #  {
-    #  $x->{value}->[$i++] = 0;                                # replace with 5 x 0
-    #  }
-    #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5];  # pad with 0
-    #my $rem = $pad % 5;                               # so much left over
-    #if ($rem > 0)
-    #  {
-    #  #print "remainder $rem\n";
-    ##  #print "elem      $x->{value}->[$s5]\n";
-    #  substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem;     # stamp w/ '0'
-    #  }
-    #$x->{value}->[$s5] = int ($x->{value}->[$s5]);    # str '05' => int '5'
-    #print ${$CALC->_str($pad->{value})}," $len\n";
-    if (($pad > 0) && ($pad <= $len))
-      {
-      substr($$xs,-$pad,$pad) = '0' x $pad;
-      $x->{value} = $CALC->_new($xs);                  # put back in
-      }
-    elsif ($pad > $len)
-      {
-      $x->bzero();                                     # round to '0'
-      }
-  #   print "res $pad $len $x $$xs\n";
+  my $put_back = 0;                                    # not yet modified
+       
+  # old code, depend on internal representation
+  # split mantissa at $pad and then pad with zeros
+  #my $s5 = int($pad / 5);
+  #my $i = 0;
+  #while ($i < $s5)
+  #  {
+  #  $x->{value}->[$i++] = 0;                          # replace with 5 x 0
+  #  }
+  #$x->{value}->[$s5] = '00000'.$x->{value}->[$s5];    # pad with 0
+  #my $rem = $pad % 5;                         # so much left over
+  #if ($rem > 0)
+  #  {
+  #  #print "remainder $rem\n";
+  ##  #print "elem      $x->{value}->[$s5]\n";
+  #  substr($x->{value}->[$s5],-$rem,$rem) = '0' x $rem;       # stamp w/ '0'
+  #  }
+  #$x->{value}->[$s5] = int ($x->{value}->[$s5]);      # str '05' => int '5'
+  #print ${$CALC->_str($pad->{value})}," $len\n";
+
+  if (($pad > 0) && ($pad <= $len))
+    {
+    substr($$xs,-$pad,$pad) = '0' x $pad;
+    $put_back = 1;
     }
-  # move this later on after the inc of the string
-  #$x->{value} = $CALC->_new($xs);                     # put back in
+  elsif ($pad > $len)
+    {
+    $x->bzero();                                       # round to '0'
+    }
+
   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
+    $put_back = 1;
+    $pad = $len, $$xs = '0'x$pad if $scale < 0;                # tlr: whack 0.51=>1.0  
+
+    # we modify directly the string variant instead of creating a number and
+    # adding it
+    my $c = 0; $pad ++;                                # for $pad == $len case
+    while ($pad <= $len)
+      {
+      $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
+      substr($$xs,-$pad,1) = $c; $pad++;
+      last if $c != 0;                         # no overflow => early out
+      }
+    $$xs = '1'.$$xs if $c == 0;
+
+    # $x->badd( Math::BigInt->new($x->{sign}.'1'. '0' x $pad) );
     }
-  # to here:
-  #$x->{value} = $CALC->_new($xs);                     # put back in
+  $x->{value} = $CALC->_new($xs) if $put_back == 1;    # put back in
 
   $x->{_a} = $scale if $scale >= 0;
   if ($scale < 0)
@@ -1789,12 +1846,8 @@ sub objectify
   #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2)
   # && ref($_[1]) && ref($_[2]);
 
-#  print "obj '",join ("' '", @_),"'\n";
-
   my $count = abs(shift || 0);
   
-#  print "MBI ",caller(),"\n";
   my @a;                       # resulting array 
   if (ref $_[0])
     {
@@ -1805,10 +1858,8 @@ sub objectify
     {
     # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
     $a[0] = $class;
-    #print "@_\n"; sleep(1); 
     $a[0] = shift if $_[0] =~ /^[A-Z].*::/;    # classname as first?
     }
-  #print caller(),"\n";
   # print "Now in objectify, my class is today $a[0]\n";
   my $k; 
   if ($count == 0)
@@ -1832,10 +1883,8 @@ sub objectify
     {
     while ($count > 0)
       {
-      #print "$count\n";
       $count--; 
       $k = shift; 
-#      print "$k (",ref($k),") => \n";
       if (!ref($k))
         {
         $k = $a[0]->new($k);
@@ -1845,19 +1894,10 @@ sub objectify
        # 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 $i = 0;
-  #foreach (@a)
-  #  {
-  #  print "o $i $a[0]\n" if $i == 0;
-  #  print "o $i ",ref($_),"\n" if $i != 0; $i++;
-  #  }
-  #print "objectify done: would return ",scalar @a," values\n";
-  #print caller(1),"\n" unless wantarray;
   die "$class objectify needs list context" unless wantarray;
   @a;
   }
@@ -1865,7 +1905,8 @@ sub objectify
 sub import 
   {
   my $self = shift;
-  #print "import $self @_\n";
+
+  $IMPORT++;
   my @a = @_; my $l = scalar @_; my $j = 0;
   for ( my $i = 0; $i < $l ; $i++,$j++ )
     {
@@ -1878,7 +1919,7 @@ sub import
     elsif ($_[$i] =~ /^lib$/i)
       {
       # this causes a different low lib to take care...
-      $CALC = $_[$i+1] || $CALC;
+      $CALC = $_[$i+1] || '';
       my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
       splice @a, $j, $s; $j -= $s;
       }
@@ -1891,11 +1932,12 @@ sub import
   # try to load core math lib
   my @c = split /\s*,\s*/,$CALC;
   push @c,'Calc';                              # if all fail, try this
+  $CALC = '';                                  # signal error
   foreach my $lib (@c)
     {
     $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
     $lib =~ s/\.pm$//;
-    if ($] < 5.6)
+    if ($] < 5.006)
       {
       # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
       # used in the same script, or eval inside import().
@@ -1905,10 +1947,11 @@ sub import
       }
     else
       {
-      eval "use $lib @c;";
+      eval "use $lib qw/@c/;";
       }
     $CALC = $lib, last if $@ eq '';    # no error in loading lib?
     }
+  die "Couldn't load any math lib, not even the default" if $CALC eq '';
   }
 
 sub __from_hex
@@ -1944,7 +1987,6 @@ sub __from_hex
       $val = substr($$hs,$i,4);
       $val =~ s/^[+-]?0x// if $len == 0;       # for last part only because
       $val = hex($val);                        # hex does not like wrong chars
-      # print "$val ",substr($$hs,$i,4),"\n";
       $i -= 4; $len --;
       $x += $mul * $val if $val != 0;
       $mul *= $x65536 if $len >= 0;            # skip last mul
@@ -2034,14 +2076,12 @@ sub _split
 
   my ($m,$e) = split /[Ee]/,$$x;
   $e = '0' if !defined $e || $e eq "";
-  # print "m '$m' e '$e'\n";
   # sign,value for exponent,mantint,mantfrac
   my ($es,$ev,$mis,$miv,$mfv);
   # valid exponent?
   if ($e =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
     {
     $es = $1; $ev = $2;
-    #print "'$m' '$e' e: $es $ev ";
     # valid mantissa?
     return if $m eq '.' || $m eq '';
     my ($mi,$mf) = split /\./,$m;
@@ -2051,11 +2091,8 @@ sub _split
     if ($mi =~ /^([+-]?)0*(\d+)$/) # strip leading zeros
       {
       $mis = $1||'+'; $miv = $2;
-      # print "$mis $miv";
-      # valid, existing fraction part of mantissa?
       return unless ($mf =~ /^(\d*?)0*$/);     # strip trailing zeros
       $mfv = $1;
-      #print " split: $mis $miv . $mfv E $es $ev\n";
       return (\$mis,\$miv,\$mfv,\$es,\$ev);
       }
     }
@@ -2089,11 +2126,11 @@ sub as_hex
   else
     {
     my $x1 = $x->copy()->babs(); my $xr;
-    my $x100 = Math::BigInt->new (0x100);
+    my $x10000 = Math::BigInt->new (0x10000);
     while (!$x1->is_zero())
       {
-      ($x1, $xr) = bdiv($x1,$x100);
-      $es .= unpack('h2',pack('C',$xr->numify()));
+      ($x1, $xr) = bdiv($x1,$x10000);
+      $es .= unpack('h4',pack('v',$xr->numify()));
       }
     $es = reverse $es;
     $es =~ s/^[0]+//;  # strip leading zeros
@@ -2119,11 +2156,11 @@ sub as_bin
   else
     {
     my $x1 = $x->copy()->babs(); my $xr;
-    my $x100 = Math::BigInt->new (0x100);
+    my $x10000 = Math::BigInt->new (0x10000);
     while (!$x1->is_zero())
       {
-      ($x1, $xr) = bdiv($x1,$x100);
-      $es .= unpack('b8',pack('C',$xr->numify()));
+      ($x1, $xr) = bdiv($x1,$x10000);
+      $es .= unpack('b16',pack('v',$xr->numify()));
       }
     $es = reverse $es; 
     $es =~ s/^[0]+//;  # strip leading zeros
index 9424143..d91272e 100644 (file)
@@ -8,7 +8,7 @@ require Exporter;
 use vars qw/@ISA $VERSION/;
 @ISA = qw(Exporter);
 
-$VERSION = '0.17';
+$VERSION = '0.20';
 
 # Package to store unsigned big integers in decimal and do math with them
 
@@ -30,9 +30,10 @@ $VERSION = '0.17';
  
 # constants for easier life
 my $nan = 'NaN';
-my ($BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2);
+my ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2,$BASE_LEN_SMALL);
 my ($AND_BITS,$XOR_BITS,$OR_BITS);
 my ($AND_MASK,$XOR_MASK,$OR_MASK);
+my ($LEN_CONVERT);
 
 sub _base_len 
   {
@@ -43,25 +44,34 @@ sub _base_len
   my $b = shift;
   if (defined $b)
     {
-    $b = 5 if $^O =~ /^uts/;   # UTS needs 5, because 6 and 7 break
-    $BASE_LEN = $b+1;
-    my $caught;
-    while (--$BASE_LEN > 5)
+    # find whether we can use mul or div or none in mul()/div()
+    # (in last case reduce BASE_LEN_SMALL)
+    $BASE_LEN_SMALL = $b+1;
+    my $caught = 0;
+    while (--$BASE_LEN_SMALL > 5)
       {
-      $BASE = int("1e".$BASE_LEN);
-      $RBASE = abs('1e-'.$BASE_LEN);                   # see USE_MUL
+      $MBASE = int("1e".$BASE_LEN_SMALL);
+      $RBASE = abs('1e-'.$BASE_LEN_SMALL);             # see USE_MUL
       $caught = 0;
-      $caught += 1 if (int($BASE * $RBASE) != 1);      # should be 1
-      $caught += 2 if (int($BASE / $BASE) != 1);       # should be 1
-      # print "caught $caught\n";
+      $caught += 1 if (int($MBASE * $RBASE) != 1);     # should be 1
+      $caught += 2 if (int($MBASE / $MBASE) != 1);     # should be 1
       last if $caught != 3;
       }
+    # BASE_LEN is used for anything else than mul()/div()
+    $BASE_LEN = $BASE_LEN_SMALL;
+    $BASE_LEN = shift if (defined $_[0]);              # one more arg?
     $BASE = int("1e".$BASE_LEN);
-    $RBASE = abs('1e-'.$BASE_LEN);                     # see USE_MUL
-    $MAX_VAL = $BASE-1;
-    $BASE_LEN2 = int($BASE_LEN / 2);                   # for mul shortcut
-    # print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE\n";
-    
+
+    $BASE_LEN2 = int($BASE_LEN_SMALL / 2);             # for mul shortcut
+    $MBASE = int("1e".$BASE_LEN_SMALL);
+    $RBASE = abs('1e-'.$BASE_LEN_SMALL);               # see USE_MUL
+    $MAX_VAL = $MBASE-1;
+    $LEN_CONVERT = 0;
+    $LEN_CONVERT = 1 if $BASE_LEN_SMALL != $BASE_LEN;
+
+    #print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE ";
+    #print "BASE_LEN_SMALL: $BASE_LEN_SMALL MBASE: $MBASE\n";
+
     if ($caught & 1 != 0)
       {
       # must USE_MUL
@@ -75,11 +85,8 @@ sub _base_len
       *{_div} = \&_div_use_div;
       }
     }
-  if (wantarray)
-    {
-    return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS);
-    }
-  $BASE_LEN;
+  return $BASE_LEN unless wantarray;
+  return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL);
   }
 
 BEGIN
@@ -92,7 +99,6 @@ BEGIN
     {
     $num = ('9' x ++$e) + 0;
     $num *= $num + 1.0;
-    # print "$num $e\n";
     } while ("$num" =~ /9{$e}0{$e}/);  # must be a certain pattern
   $e--;                                # last test failed, so retract one step
   # the limits below brush the problems with the test above under the rug:
@@ -102,11 +108,31 @@ BEGIN
                                # there, but we play safe)
   $e = 8 if $e > 8;            # cap, for VMS, OS/390 and other 64 bit systems
 
-  __PACKAGE__->_base_len($e);  # set and store
+  # determine how many digits fit into an integer and can be safely added 
+  # together plus carry w/o causing an overflow
+
+  # this below detects 15 on a 64 bit system, because after that it becomes
+  # 1e16  and not 1000000 :/ I can make it detect 18, but then I get a lot of
+  # test failures. Ugh! (Tomake detect 18: uncomment lines marked with *)
+  use integer;
+  my $bi = 5;                  # approx. 16 bit
+  $num = int('9' x $bi);
+  # $num = 99999; # *
+  # while ( ($num+$num+1) eq '1' . '9' x $bi)  # *
+  while ( int($num+$num+1) eq '1' . '9' x $bi)
+    {
+    $bi++; $num = int('9' x $bi);
+    # $bi++; $num *= 10; $num += 9;    # *
+    }
+  $bi--;                               # back off one step
+  # by setting them equal, we ignore the findings and use the default
+  # one-size-fits-all approach from former versions
+  $bi = $e;                            # XXX, this should work always
+
+  __PACKAGE__->_base_len($e,$bi);      # set and store
 
   # find out how many bits _and, _or and _xor can take (old default = 16)
   # I don't think anybody has yet 128 bit scalars, so let's play safe.
-  use integer;
   local $^W = 0;       # don't warn about 'nonportable number'
   $AND_BITS = 15; $XOR_BITS = 15; $OR_BITS  = 15;
 
@@ -134,11 +160,76 @@ BEGIN
     } while ($OR_BITS < $max && $x == $z && $y == $x);
   $OR_BITS --;                                         # retreat one step
   
-  # print "AND $AND_BITS XOR $XOR_BITS OR $OR_BITS\n";
   }
 
 ##############################################################################
-# create objects from various representations
+# convert between the "small" and the "large" representation
+
+sub _to_large
+  {
+  # take an array in base $BASE_LEN_SMALL and convert it in-place to $BASE_LEN
+  my ($c,$x) = @_;
+
+#  print "_to_large $BASE_LEN_SMALL => $BASE_LEN\n";
+
+  return $x if $LEN_CONVERT == 0 ||            # nothing to converconvertor
+        @$x == 1;                              # only one element => early out
+  
+  #     12345    67890    12345    67890   contents
+  # to      3        2        1        0   index 
+  #             123456  7890123  4567890   contents 
+
+#  # faster variant
+#  my @d; my $str = '';
+#  my $z = '0' x $BASE_LEN_SMALL;
+#  foreach (@$x)
+#    {
+#    # ... . 04321 . 000321
+#    $str = substr($z.$_,-$BASE_LEN_SMALL,$BASE_LEN_SMALL) . $str;
+#    if (length($str) > $BASE_LEN)
+#      {
+#      push @d, substr($str,-$BASE_LEN,$BASE_LEN);     # extract one piece
+#      substr($str,-$BASE_LEN,$BASE_LEN) = '';         # remove it
+#      }
+#    }
+#  push @d, $str if $str !~ /^0*$/;                    # extract last piece
+#  @$x = @d;
+#  $x->[-1] = int($x->[-1]);                   # strip leading zero
+#  $x;
+
+  my $ret = "";
+  my $l = scalar @$x;          # number of parts
+  $l --; $ret .= int($x->[$l]); $l--;
+  my $z = '0' x ($BASE_LEN_SMALL-1);                            
+  while ($l >= 0)
+    {
+    $ret .= substr($z.$x->[$l],-$BASE_LEN_SMALL); 
+    $l--;
+    }
+  my $str = _new($c,\$ret);                    # make array
+  @$x = @$str;                                 # clobber contents of $x
+  $x->[-1] = int($x->[-1]);                    # strip leading zero
+  }
+
+sub _to_small
+  {
+  # take an array in base $BASE_LEN and convert it in-place to $BASE_LEN_SMALL
+  my ($c,$x) = @_;
+
+  return $x if $LEN_CONVERT == 0;              # nothing to do
+  return $x if @$x == 1 && length(int($x->[0])) <= $BASE_LEN_SMALL;
+
+  my $d = _str($c,$x);
+  my $il = length($$d)-1;
+  ## this leaves '00000' instead of int 0 and will be corrected after any op
+  # clobber contents of $x
+  @$x = reverse(unpack("a" . ($il % $BASE_LEN_SMALL+1) 
+      . ("a$BASE_LEN_SMALL" x ($il / $BASE_LEN_SMALL)), $$d)); 
+
+  $x->[-1] = int($x->[-1]);                    # strip leading zero
+  }
+
+###############################################################################
 
 sub _new
   {
@@ -146,9 +237,9 @@ sub _new
   # Convert a number from string format to internal base 100000 format.
   # Assumes normalized value as input.
   my $d = $_[1];
-  my $il = CORE::length($$d)-1;
-  # these leaves '00000' instead of int 0 and will be corrected after any op
-  return [ reverse(unpack("a" . ($il % $BASE_LEN+1) 
+  my $il = length($$d)-1;
+  # this leaves '00000' instead of int 0 and will be corrected after any op
+  [ reverse(unpack("a" . ($il % $BASE_LEN+1) 
     . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
   }                                                                             
   
@@ -162,24 +253,24 @@ BEGIN
 sub _zero
   {
   # create a zero
-  return [ 0 ];
+  [ 0 ];
   }
 
 sub _one
   {
   # create a one
-  return [ 1 ];
+  [ 1 ];
   }
 
 sub _two
   {
   # create a two (for _pow)
-  return [ 2 ];
+  [ 2 ];
   }
 
 sub _copy
   {
-  return [ @{$_[1]} ];
+  [ @{$_[1]} ];
   }
 
 # catch and throw away
@@ -195,11 +286,13 @@ sub _str
   # internal format is always normalized (no leading zeros, "-0" => "+0")
   my $ar = $_[1];
   my $ret = "";
-  my $l = scalar @$ar;         # number of parts
-  return $nan if $l < 1;       # should not happen
+
+  my $l = scalar @$ar;         # number of parts
+  return $nan if $l < 1;       # should not happen
+
   # handle first one different to strip leading zeros from it (there are no
   # leading zero parts in internal representation)
-  $l --; $ret .= $ar->[$l]; $l--;
+  $l --; $ret .= int($ar->[$l]); $l--;
   # Interestingly, the pre-padd method uses more time
   # the old grep variant takes longer (14 to 10 sec)
   my $z = '0' x ($BASE_LEN-1);                            
@@ -208,7 +301,7 @@ sub _str
     $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
     $l--;
     }
-  return \$ret;
+  \$ret;
   }                                                                             
 
 sub _num
@@ -222,7 +315,7 @@ sub _num
     {
     $num += $fac*$_; $fac *= $BASE;
     }
-  return $num; 
+  $num; 
   }
 
 ##############################################################################
@@ -252,7 +345,7 @@ sub _add
     {
     $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
     }
-  return $x;
+  $x;
   }                                                                             
 
 sub _inc
@@ -265,13 +358,10 @@ sub _inc
   for my $i (@$x)
     {
     return $x if (($i += 1) < $BASE);          # early out
-    $i -= $BASE;
+    $i = 0;                                    # overflow, next
     }
-  if ($x->[-1] == 0)                           # last overflowed
-    {
-    push @$x,1;                                        # extend
-    }
-  return $x;
+  push @$x,1 if ($x->[-1] == 0);               # last overflowed, so extend
+  $x;
   }                                                                             
 
 sub _dec
@@ -281,13 +371,14 @@ sub _dec
   # This routine clobbers up array x, but not y.
   my ($c,$x) = @_;
 
+  my $MAX = $BASE-1;                           # since MAX_VAL based on MBASE
   for my $i (@$x)
     {
     last if (($i -= 1) >= 0);                  # early out
-    $i = $MAX_VAL;
+    $i = $MAX;                                 # overflow, next
     }
   pop @$x if $x->[-1] == 0 && @$x > 1;         # last overflowed (but leave 0)
-  return $x;
+  $x;
   }                                                                             
 
 sub _sub
@@ -330,6 +421,7 @@ sub _mul_use_mul
 
   # shortcut for two very short numbers
   # +0 since part maybe string '00001' from new()
+  # works also if xv and yv are the same reference
   if ((@$xv == 1) && (@$yv == 1)
    && (length($xv->[0]+0) <= $BASE_LEN2)
    && (length($yv->[0]+0) <= $BASE_LEN2))
@@ -338,9 +430,15 @@ sub _mul_use_mul
    return $xv;
    }
   
-  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?
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_small($xv); $c->_to_small($yv);
+    }
+
+  my @prod = (); my ($prod,$car,$cty,$xi,$yi);
+
   for $xi (@$xv)
     {
     $car = 0; $cty = 0;
@@ -350,7 +448,7 @@ sub _mul_use_mul
 #      {
 #      $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
 #      $prod[$cty++] =
-#       $prod - ($car = int($prod * RBASE)) * $BASE;  # see USE_MUL
+#       $prod - ($car = int($prod * RBASE)) * $MBASE;  # see USE_MUL
 #      }
 #    $prod[$cty] += $car if $car; # need really to check for 0?
 #    $xi = shift @prod;
@@ -364,13 +462,22 @@ sub _mul_use_mul
 ##     this is actually a tad slower
 ##        $prod = $prod[$cty]; $prod += ($car + $xi * $yi);    # no ||0 here
       $prod[$cty++] =
-       $prod - ($car = int($prod * $RBASE)) * $BASE;  # see USE_MUL
+       $prod - ($car = int($prod * $RBASE)) * $MBASE;  # see USE_MUL
       }
     $prod[$cty] += $car if $car; # need really to check for 0?
     $xi = shift @prod || 0;    # || 0 makes v5.005_3 happy
     }
   push @$xv, @prod;
-  __strip_zeros($xv);
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_large($yv);
+    $c->_to_large($xv);
+    }
+  else
+    {
+    __strip_zeros($xv);
+    }
+  $xv;
   }                                                                             
 
 sub _mul_use_div
@@ -382,6 +489,7 @@ sub _mul_use_div
  
   # shortcut for two very short numbers
   # +0 since part maybe string '00001' from new()
+  # works also if xv and yv are the same reference
   if ((@$xv == 1) && (@$yv == 1)
    && (length($xv->[0]+0) <= $BASE_LEN2)
    && (length($yv->[0]+0) <= $BASE_LEN2))
@@ -389,10 +497,15 @@ sub _mul_use_div
    $xv->[0] *= $yv->[0];
    return $xv;
    }
-  
-  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?
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_small($xv); $c->_to_small($yv);
+    }
+  
+  my @prod = (); my ($prod,$car,$cty,$xi,$yi);
   for $xi (@$xv)
     {
     $car = 0; $cty = 0;
@@ -402,13 +515,22 @@ sub _mul_use_div
       {
       $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
       $prod[$cty++] =
-       $prod - ($car = int($prod / $BASE)) * $BASE;
+       $prod - ($car = int($prod / $MBASE)) * $MBASE;
       }
     $prod[$cty] += $car if $car; # need really to check for 0?
     $xi = shift @prod || 0;    # || 0 makes v5.005_3 happy
     }
   push @$xv, @prod;
-  __strip_zeros($xv);
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_large($yv);
+    $c->_to_large($xv);
+    }
+  else
+    {
+    __strip_zeros($xv);
+    }
+  $xv;
   }                                                                             
 
 sub _div_use_mul
@@ -416,25 +538,44 @@ sub _div_use_mul
   # ref to array, ref to array, modify first array and return remainder if 
   # in list context
   my ($c,$x,$yorg) = @_;
-  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
 
-  my (@d,$tmp,$q,$u2,$u1,$u0);
+  if (@$x == 1 && @$yorg == 1)
+    {
+    # shortcut, $y is smaller than $x
+    if (wantarray)
+      {
+      my $r = [ $x->[0] % $yorg->[0] ];
+      $x->[0] = int($x->[0] / $yorg->[0]);
+      return ($x,$r); 
+      }
+    else
+      {
+      $x->[0] = int($x->[0] / $yorg->[0]);
+      return $x; 
+      }
+    }
 
-  $car = $bar = $prd = 0;
-  
   my $y = [ @$yorg ];
-  if (($dd = int($BASE/($y->[-1]+1))) != 1) 
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_small($x); $c->_to_small($y);
+    }
+
+  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
+
+  $car = $bar = $prd = 0;
+  if (($dd = int($MBASE/($y->[-1]+1))) != 1) 
     {
     for $xi (@$x) 
       {
       $xi = $xi * $dd + $car;
-      $xi -= ($car = int($xi * $RBASE)) * $BASE;       # see USE_MUL
+      $xi -= ($car = int($xi * $RBASE)) * $MBASE;      # see USE_MUL
       }
     push(@$x, $car); $car = 0;
     for $yi (@$y) 
       {
       $yi = $yi * $dd + $car;
-      $yi -= ($car = int($yi * $RBASE)) * $BASE;       # see USE_MUL
+      $yi -= ($car = int($yi * $RBASE)) * $MBASE;      # see USE_MUL
       }
     }
   else 
@@ -449,25 +590,24 @@ sub _div_use_mul
     $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);
+     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
+    --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$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 * $RBASE)) * $BASE;   # see USE_MUL
-       $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+        $prd -= ($car = int($prd * $RBASE)) * $MBASE;  # see USE_MUL
+       $x->[$xi] += $MBASE 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));
+         $x->[$xi] -= $MBASE
+          if ($car = (($x->[$xi] += $y->[$yi] + $car) > $MBASE));
          }
        }   
       }
@@ -481,7 +621,7 @@ sub _div_use_mul
       $car = 0; 
       for $xi (reverse @$x) 
         {
-        $prd = $car * $BASE + $xi;
+        $prd = $car * $MBASE + $xi;
         $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL
         unshift(@d, $tmp);
         }
@@ -491,15 +631,28 @@ sub _div_use_mul
       @d = @$x;
       }
     @$x = @q;
-    __strip_zeros($x); 
-    __strip_zeros(\@d);
-    _check('',$x);
-    _check('',\@d);
-    return ($x,\@d);
+    my $d = \@d; 
+    if ($LEN_CONVERT != 0)
+      {
+      $c->_to_large($x); $c->_to_large($d);
+      }
+    else
+      {
+      __strip_zeros($x);
+      __strip_zeros($d);
+      }
+    return ($x,$d);
     }
   @$x = @q;
-  __strip_zeros($x); 
-    _check('',$x);
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_large($x);
+    }
+  else
+    {
+    __strip_zeros($x);
+    }
+  $x;
   }
 
 sub _div_use_div
@@ -507,25 +660,44 @@ sub _div_use_div
   # ref to array, ref to array, modify first array and return remainder if 
   # in list context
   my ($c,$x,$yorg) = @_;
-  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
 
-  my (@d,$tmp,$q,$u2,$u1,$u0);
+  if (@$x == 1 && @$yorg == 1)
+    {
+    # shortcut, $y is smaller than $x
+    if (wantarray)
+      {
+      my $r = [ $x->[0] % $yorg->[0] ];
+      $x->[0] = int($x->[0] / $yorg->[0]);
+      return ($x,$r); 
+      }
+    else
+      {
+      $x->[0] = int($x->[0] / $yorg->[0]);
+      return $x; 
+      }
+    }
 
-  $car = $bar = $prd = 0;
-  
   my $y = [ @$yorg ];
-  if (($dd = int($BASE/($y->[-1]+1))) != 1) 
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_small($x); $c->_to_small($y);
+    }
+  my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
+
+  $car = $bar = $prd = 0;
+  if (($dd = int($MBASE/($y->[-1]+1))) != 1) 
     {
     for $xi (@$x) 
       {
       $xi = $xi * $dd + $car;
-      $xi -= ($car = int($xi / $BASE)) * $BASE;
+      $xi -= ($car = int($xi / $MBASE)) * $MBASE;
       }
     push(@$x, $car); $car = 0;
     for $yi (@$y) 
       {
       $yi = $yi * $dd + $car;
-      $yi -= ($car = int($yi / $BASE)) * $BASE;
+      $yi -= ($car = int($yi / $MBASE)) * $MBASE;
       }
     }
   else 
@@ -540,29 +712,28 @@ sub _div_use_div
     $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);
+     $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1));
+    --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$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));
+        $prd -= ($car = int($prd / $MBASE)) * $MBASE;
+       $x->[$xi] += $MBASE 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));
+         $x->[$xi] -= $MBASE
+          if ($car = (($x->[$xi] += $y->[$yi] + $car) > $MBASE));
          }
        }   
       }
-      pop(@$x); unshift(@q, $q);
+    pop(@$x); unshift(@q, $q);
     }
   if (wantarray) 
     {
@@ -572,7 +743,7 @@ sub _div_use_div
       $car = 0; 
       for $xi (reverse @$x) 
         {
-        $prd = $car * $BASE + $xi;
+        $prd = $car * $MBASE + $xi;
         $car = $prd - ($tmp = int($prd / $dd)) * $dd;
         unshift(@d, $tmp);
         }
@@ -582,12 +753,28 @@ sub _div_use_div
       @d = @$x;
       }
     @$x = @q;
-    __strip_zeros($x); 
-    __strip_zeros(\@d);
-    return ($x,\@d);
+    my $d = \@d; 
+    if ($LEN_CONVERT != 0)
+      {
+      $c->_to_large($x); $c->_to_large($d);
+      }
+    else
+      {
+      __strip_zeros($x);
+      __strip_zeros($d);
+      }
+    return ($x,$d);
     }
   @$x = @q;
-  __strip_zeros($x); 
+  if ($LEN_CONVERT != 0)
+    {
+    $c->_to_large($x);
+    }
+  else
+    {
+    __strip_zeros($x);
+    }
+  $x;
   }
 
 ##############################################################################
@@ -601,7 +788,7 @@ sub _acmp
 
   my ($c,$cx,$cy) = @_;
 
-  # fat comp based on array elements
+  # fast comp based on array elements
   my $lxy = scalar @$cx - scalar @$cy;
   return -1 if $lxy < 0;                               # already differs, ret
   return 1 if $lxy > 0;                                        # ditto
@@ -624,7 +811,8 @@ sub _acmp
    }
   return 1 if $a > 0;
   return -1 if $a < 0;
-  return 0;                                    # equal
+  0;                                   # equal
+
   # while it early aborts, it is even slower than the manual variant
   #grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
   # grep way, go trough all (bad for early ne)
@@ -675,12 +863,12 @@ sub _zeros
       $elem = "$e";                            # preserve x
       $elem =~ s/.*?(0*$)/$1/;                 # strip anything not zero
       $zeros *= $BASE_LEN;                     # elems * 5
-      $zeros += CORE::length($elem);           # count trailing zeros
+      $zeros += length($elem);                 # count trailing zeros
       last;                                    # early out
       }
     $zeros ++;                                 # real else branch: 50% slower!
     }
-  return $zeros;
+  $zeros;
   }
 
 ##############################################################################
@@ -690,28 +878,31 @@ sub _is_zero
   {
   # return true if arg (BINT or num_str) is zero (array '+', '0')
   my $x = $_[1];
-  return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
+
+  (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
   }
 
 sub _is_even
   {
   # return true if arg (BINT or num_str) is even
   my $x = $_[1];
-  return (!($x->[0] & 1)) <=> 0; 
+  (!($x->[0] & 1)) <=> 0; 
   }
 
 sub _is_odd
   {
   # return true if arg (BINT or num_str) is even
   my $x = $_[1];
-  return (($x->[0] & 1)) <=> 0; 
+
+  (($x->[0] & 1)) <=> 0; 
   }
 
 sub _is_one
   {
   # return true if arg (BINT or num_str) is one (array '+', '1')
   my $x = $_[1];
-  return (scalar @$x == 1) && ($x->[0] == 1) <=> 0; 
+
+  (scalar @$x == 1) && ($x->[0] == 1) <=> 0; 
   }
 
 sub __strip_zeros
@@ -724,6 +915,8 @@ sub __strip_zeros
   my $i = $cnt-1;
   push @$s,0 if $i < 0;                # div might return empty results, so fix it
 
+  return $s if @$s == 1;               # early out
+
   #print "strip: cnt $cnt i $i\n";
   # '0', '3', '4', '0', '0',
   #  0    1    2    3    4
@@ -794,7 +987,7 @@ sub _mod
     return $x;
     }
 
-  # @y is single element, but  @x has more than one
+  # @y is single element, but @x has more than one
   my $b = $BASE % $y;
   if ($b == 0)
     {
@@ -830,7 +1023,7 @@ sub _mod
     $x->[0] = $r;
     }
   splice (@$x,1);
-  return $x;
+  $x;
   }
 
 ##############################################################################
@@ -842,39 +1035,37 @@ sub _rsft
 
   if ($n != 10)
     {
-    return;    # we cant do this here, due to now _pow, so signal failure
+    $n = _new($c,\$n); return _div($c,$x, _pow($c,$n,$y));
+    }
+
+  # shortcut (faster) for shifting by 10)
+  # multiples of $BASE_LEN
+  my $dst = 0;                         # destination
+  my $src = _num($c,$y);               # as normal int
+  my $rem = $src % $BASE_LEN;          # remainder to shift
+  $src = int($src / $BASE_LEN);                # source
+  if ($rem == 0)
+    {
+    splice (@$x,0,$src);               # even faster, 38.4 => 39.3
     }
   else
     {
-    # shortcut (faster) for shifting by 10)
-    # multiples of $BASE_LEN
-    my $dst = 0;                               # destination
-    my $src = _num($c,$y);                     # as normal int
-    my $rem = $src % $BASE_LEN;                        # remainder to shift
-    $src = int($src / $BASE_LEN);              # source
-    if ($rem == 0)
+    my $len = scalar @$x - $src;       # elems to go
+    my $vd; my $z = '0'x $BASE_LEN;
+    $x->[scalar @$x] = 0;              # avoid || 0 test inside loop
+    while ($dst < $len)
       {
-      splice (@$x,0,$src);                     # even faster, 38.4 => 39.3
+      $vd = $z.$x->[$src];
+      $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
+      $src++;
+      $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
+      $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+      $x->[$dst] = int($vd);
+      $dst++;
       }
-    else
-      {
-      my $len = scalar @$x - $src;             # elems to go
-      my $vd; my $z = '0'x $BASE_LEN;
-      $x->[scalar @$x] = 0;                    # avoid || 0 test inside loop
-      while ($dst < $len)
-        {
-        $vd = $z.$x->[$src];
-        $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
-        $src++;
-        $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
-        $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
-        $x->[$dst] = int($vd);
-        $dst++;
-        }
-      splice (@$x,$dst) if $dst > 0;           # kill left-over array elems
-      pop @$x if $x->[-1] == 0;                        # kill last element if 0
-      } # else rem == 0
-    }
+    splice (@$x,$dst) if $dst > 0;             # kill left-over array elems
+    pop @$x if $x->[-1] == 0;                  # kill last element if 0
+    } # else rem == 0
   $x;
   }
 
@@ -884,33 +1075,31 @@ sub _lsft
 
   if ($n != 10)
     {
-    return;    # we cant do this here, due to now _pow, so signal failure
+    $n = _new($c,\$n); return _mul($c,$x, _pow($c,$n,$y));
     }
-  else
+
+  # shortcut (faster) for shifting by 10) since we are in base 10eX
+  # multiples of $BASE_LEN:
+  my $src = scalar @$x;                        # source
+  my $len = _num($c,$y);               # shift-len as normal int
+  my $rem = $len % $BASE_LEN;          # remainder to shift
+  my $dst = $src + int($len/$BASE_LEN);        # destination
+  my $vd;                              # further speedup
+  $x->[$src] = 0;                      # avoid first ||0 for speed
+  my $z = '0' x $BASE_LEN;
+  while ($src >= 0)
     {
-    # shortcut (faster) for shifting by 10) since we are in base 10eX
-    # multiples of $BASE_LEN:
-    my $src = scalar @$x;                      # source
-    my $len = _num($c,$y);                     # shift-len as normal int
-    my $rem = $len % $BASE_LEN;                        # remainder to shift
-    my $dst = $src + int($len/$BASE_LEN);      # destination
-    my $vd;                                    # further speedup
-    $x->[$src] = 0;                            # avoid first ||0 for speed
-    my $z = '0' x $BASE_LEN;
-    while ($src >= 0)
-      {
-      $vd = $x->[$src]; $vd = $z.$vd;
-      $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
-      $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
-      $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
-      $x->[$dst] = int($vd);
-      $dst--; $src--;
-      }
-    # set lowest parts to 0
-    while ($dst >= 0) { $x->[$dst--] = 0; }
-    # fix spurios last zero element
-    splice @$x,-1 if $x->[-1] == 0;
+    $vd = $x->[$src]; $vd = $z.$vd;
+    $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
+    $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
+    $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+    $x->[$dst] = int($vd);
+    $dst--; $src--;
     }
+  # set lowest parts to 0
+  while ($dst >= 0) { $x->[$dst--] = 0; }
+  # fix spurios last zero element
+  splice @$x,-1 if $x->[-1] == 0;
   $x;
   }
 
@@ -930,10 +1119,10 @@ sub _pow
     _mul($c,$cx,$cx);
     }
   _mul($c,$cx,$pow2) unless _is_one($c,$pow2);
-  return $cx;
+  $cx;
   }
 
-sub _sqrt
+sub _sqrt1
   {
   # square-root of $x
   # ref to array, return ref to array
@@ -946,12 +1135,20 @@ sub _sqrt
     return $x;
     } 
   my $y = _copy($c,$x);
-  my $l = [ _len($c,$x) / 2 ];
+  my $l = _len($c,$x) / 2;     # hopefully _len/2 is < $BASE
+  # my $l2 = [ _len($c,$x) / 2 ];      # old way: hopefully _len/2 is < $BASE
 
   splice @$x,0; $x->[0] = 1;   # keep ref($x), but modify it
 
-  _lsft($c,$x,$l,10);
+  # old way
+  # _lsft($c,$x,$l2,10);
 
+  # construct $x (instead of _lsft($c,$x,$l,10)
+  my $r = $l % $BASE_LEN;      # 10000 00000 00000 00000 ($BASE_LEN=5)
+  $l = int($l / $BASE_LEN);
+  $x->[$l--] = int('1' . '0' x $r);
+  $x->[$l--] = 0 while ($l >= 0);
   my $two = _two();
   my $last = _zero();
   my $lastlast = _zero();
@@ -1000,7 +1197,8 @@ sub _and
 #    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
 #    _add($c,$x, _mul($c, _new( $c, \($xrr & $yrr) ), $m) );
     
-    _add($c,$x, _mul($c, [ $xr->[0] & $yr->[0] ], $m) );
+    # 0+ due to '&' doesn't work in strings
+    _add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) );
     _mul($c,$m,$mask);
     }
   $x;
@@ -1028,8 +1226,9 @@ sub _xor
     #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
     #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
     #_add($c,$x, _mul($c, _new( $c, \($xrr ^ $yrr) ), $m) );
-    
-    _add($c,$x, _mul($c, [ $xr->[0] ^ $yr->[0] ], $m) );
+
+    # 0+ due to '^' doesn't work in strings
+    _add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) );
     _mul($c,$m,$mask);
     }
   # the loop stops when the shorter of the two numbers is exhausted
@@ -1064,7 +1263,8 @@ sub _or
 #    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
 #    _add($c,$x, _mul($c, _new( $c, \($xrr | $yrr) ), $m) );
     
-    _add($c,$x, _mul($c, [ $xr->[0] | $yr->[0] ], $m) );
+    # 0+ due to '|' doesn't work in strings
+    _add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) );
     _mul($c,$m,$mask);
     }
   # the loop stops when the shorter of the two numbers is exhausted
@@ -1076,6 +1276,48 @@ sub _or
   $x;
   }
 
+sub _as_hex
+  {
+  # convert a decimal number to hex (ref to array, return ref to string)
+  my ($c,$x) = @_;
+
+  my $x1 = _copy($c,$x);
+
+  my $es = '';
+  my $xr;
+  my $x10000 = [ 0x10000 ];
+  while (! _is_zero($c,$x1))
+    {
+    ($x1, $xr) = _div($c,$x1,$x10000);
+    $es .= unpack('h4',pack('v',$xr->[0]));
+    }
+  $es = reverse $es;
+  $es =~ s/^[0]+//;   # strip leading zeros
+  $es = '0x' . $es;
+  \$es;
+  }
+
+sub _as_bin
+  {
+  # convert a decimal number to bin (ref to array, return ref to string)
+  my ($c,$x) = @_;
+
+  my $x1 = _copy($c,$x);
+
+  my $es = '';
+  my $xr;
+  my $x10000 = [ 0x10000 ];
+  while (! _is_zero($c,$x1))
+    {
+    ($x1, $xr) = _div($c,$x1,$x10000);
+    $es .= unpack('b16',pack('v',$xr->[0]));
+    }
+  $es = reverse $es;
+  $es =~ s/^[0]+//;   # strip leading zeros
+  $es = '0b' . $es;
+  \$es;
+  }
+
 sub _from_hex
   {
   # convert a hex number to decimal (ref to string, return ref to array)
@@ -1085,7 +1327,7 @@ sub _from_hex
   my $m = [ 0x10000 ];                         # 16 bit at a time
   my $x = _zero();
 
-  my $len = CORE::length($$hs)-2;
+  my $len = length($$hs)-2;
   $len = int($len/4);                          # 4-digit parts, w/o '0x'
   my $val; my $i = -4;
   while ($len >= 0)
@@ -1109,7 +1351,7 @@ sub _from_bin
   my $m = [ 0x100 ];                           # 8 bit at a time
   my $x = _zero();
 
-  my $len = CORE::length($$bs)-2;
+  my $len = length($$bs)-2;
   $len = int($len/8);                          # 4-digit parts, w/o '0x'
   my $val; my $i = -8;
   while ($len >= 0)
@@ -1117,8 +1359,6 @@ sub _from_bin
     $val = substr($$bs,$i,8);
     $val =~ s/^[+-]?0b// if $len == 0;         # for last part only
 
-    #$val = oct('0b'.$val);   # does not work on Perl prior to 5.6.0
-    # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
     $val = ord(pack('B8',substr('00000000'.$val,-8,8))); 
 
     $i -= 8; $len --;
index 03aed46..5b2df41 100644 (file)
@@ -8,7 +8,6 @@ BEGIN
   $| = 1;
   # to locate the testing files
   my $location = $0; $location =~ s/bare_mbi.t//i;
-  print "loc $location\n";
   if ($ENV{PERL_CORE})
     {
     # testing with the core distribution
@@ -27,16 +26,18 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1865;
+  plan tests => 2005;
   }
 
 use Math::BigInt lib => 'BareCalc';
 
+print "# ",Math::BigInt::_core_lib(),"\n";
+
 use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
 $class = "Math::BigInt";
 $CL = "Math::BigInt::BareCalc";
 
-my $version = '1.48';   # for $VERSION tests, match current release (by hand!)
+my $version = '1.49';   # for $VERSION tests, match current release (by hand!)
 
 require 'bigintpm.inc';        # perform same tests as bigintpm
 
index b61af2a..a5e527e 100644 (file)
@@ -76,6 +76,8 @@ while (<DATA>)
       $try .= "\$y = new $class \"$args[1]\";";
       if ($f eq "fcmp") {
         $try .= '$x <=> $y;';
+      } elsif ($f eq "flog") {
+        $try .= '$x->flog($y);';
       } elsif ($f eq "facmp") {
         $try .= '$x->facmp($y);';
       } elsif ($f eq "fpow") {
@@ -139,6 +141,7 @@ ok ($y,1200); ok ($x,1200);
 
 ###############################################################################
 # fdiv() in list context
+
 $x = $class->bzero(); ($x,$y) = $x->fdiv(0);
 ok ($x,'NaN'); ok ($y,'NaN');
 
@@ -150,6 +153,26 @@ $x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
 $x = $class->new(2); $x->finf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
 $x = $class->new(2); $x->fone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
 $x = $class->new(2); $x->fnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+        
+###############################################################################
+# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt()
+# correctly modifies $x
+
+$class->accuracy(undef); $class->precision(undef);     # reset
+
+$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46');
+
+$class->precision(undef);
+$x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3');
+
+$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464');
+
+# A and P set => NaN
+$class->accuracy(4); $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN');
+# supplied arg overrides set global
+$class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46');
+
+$class->accuracy(undef); $class->precision(undef); # reset for further tests
 
 1; # all done
 
@@ -165,6 +188,17 @@ sub ok_undef
   }
 
 __DATA__
+#&flog
+#$div_scale = 14;
+#10:0:2.30258509299405
+#1000:0:6.90775527898214
+#100:0:4.60517018598809
+#2:0:0.693147180559945
+#3.1415:0:1.14470039286086
+#12345:0:9.42100640177928
+#0.001:0:-6.90775527898214
+## reset for further tests
+#$div_scale = 40;
 &frsft
 #NaNfrsft:NaN
 0:2:0
@@ -924,14 +958,89 @@ $div_scale = 1
 # 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
++9:4:1
++9:5:4
++9000:56:40
++56:9000:56
+# inf handling, see table in doc
+0:inf:0
+0:-inf:0
+5:inf:5
+5:-inf:5
+-5:inf:-5
+-5:-inf:-5
+inf:5:0
+-inf:5:0
+inf:-5:0
+-inf:-5:0
+5:5:0
+-5:-5:0
+inf:inf:0
+-inf:-inf:0
+-inf:inf:0
+inf:-inf:0
+8:0:8
+inf:0:inf
+# exceptions to reminder rule
+-inf:0:-inf
+-8:0:-8
+0:0:NaN
+abc:abc:NaN
+abc:1:abc:NaN
+1:abc:NaN
+0:0:NaN
+0:1:0
+1:0:1
+0:-1:0
+-1:0:-1
+1:1:0
+-1:-1:0
+1:-1:0
+-1:1:0
+1:2:1
+2:1:0
+1000000000:9:1
+2000000000:9:2
+3000000000:9:3
+4000000000:9:4
+5000000000:9:5
+6000000000:9:6
+7000000000:9:7
+8000000000:9:8
+9000000000:9:0
+35500000:113:33
+71000000:226:66
+106500000:339:99
+1000000000:3:1
+10:5:0
+100:4:0
+1000:8:0
+10000:16:0
+999999999999:9:0
+999999999999:99:0
+999999999999:999:0
+999999999999:9999:0
+999999999999999:99999:0
+-9:+5:1
++9:-5:-1
+-9:-5:-4
+-5:3:1
+-2:3:1
+4:3:1
+1:3:1
+-5:-3:-2
+-2:-3:-2
+4:-3:-2
+1:-3:-2
+4095:4095:0
+100041000510123:3:0
+152403346:12345:4321
+87654321:87654321:0
+# now some floating point tests
+123:2.5:0.5
+1230:2.5:0
+123.4:2.5:0.9
+123e1:25:5
 &fsqrt
 +0:0
 -1:NaN
@@ -953,6 +1062,8 @@ nanfsqrt:NaN
 # sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4
 1.44E10:120000
 2e10:141421.356237309504880168872420969807857
+# proved to be an endless loop under 7-9
+12:3.464101615137754587054892683011744733886
 &is_nan
 123:0
 abc:1
index c31d7f1..2c98122 100755 (executable)
@@ -26,12 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-#  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 => 1367;
+  plan tests => 1528;
   }
 
 use Math::BigInt;
index 05b5fcc..220ce30 100644 (file)
@@ -8,29 +8,52 @@ BEGIN
   $| = 1;
   chdir 't' if -d 't';
   unshift @INC, '../lib'; # for running manually
-  plan tests => 63;
+  }
+
+use Math::BigInt::Calc;
+
+BEGIN
+  {
+  my $additional = 0;
+  $additional = 27 if $Math::BigInt::Calc::VERSION > 0.18;
+  plan tests => 71 + $additional;
   }
 
 # testing of Math::BigInt::Calc, primarily for interface/api and not for the
 # math functionality
 
-use Math::BigInt::Calc;
-
 my $C = 'Math::BigInt::Calc';  # pass classname to sub's
 
 # _new and _str
 my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
 ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
 
+###############################################################################
 # _add, _sub, _mul, _div
 ok (${$C->_str($C->_add($x,$y))},444);
 ok (${$C->_str($C->_sub($x,$y))},123);
 ok (${$C->_str($C->_mul($x,$y))},39483);
 ok (${$C->_str($C->_div($x,$y))},123);
 
+###############################################################################
+# check that mul/div doesn't change $y
+# and returns the same reference, not something new
 ok (${$C->_str($C->_mul($x,$y))},39483);
-ok (${$C->_str($x)},39483);
-ok (${$C->_str($y)},321);
+ok (${$C->_str($x)},39483); ok (${$C->_str($y)},321);
+
+ok (${$C->_str($C->_div($x,$y))},123);
+ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
+
+$x = $C->_new(\"39483");
+my ($x1,$r1) = $C->_div($x,$y);
+ok ("$x1","$x");
+$C->_inc($x1);
+ok ("$x1","$x");
+ok (${$C->_str($r1)},'0');
+
+$x = $C->_new(\"39483");       # reset
+
+###############################################################################
 my $z = $C->_new(\"2");
 ok (${$C->_str($C->_add($x,$z))},39485);
 my ($re,$rr) = $C->_div($x,$y);
@@ -71,28 +94,16 @@ $x = $C->_new(\"10"); $y = $C->_new(\"3");
 ok (${$C->_str($C->_lsft($x,$y,10))},10000);
 $x = $C->_new(\"20"); $y = $C->_new(\"3"); 
 ok (${$C->_str($C->_lsft($x,$y,10))},20000);
+
 $x = $C->_new(\"128"); $y = $C->_new(\"4");
-if (!defined $C->_lsft($x,$y,2)) 
-  {
-  ok (1,1) 
-  }
-else
-  {
-  ok ('_lsft','undef');
-  }
+ok (${$C->_str($C->_lsft($x,$y,2))}, 128 << 4);
+
 $x = $C->_new(\"1000"); $y = $C->_new(\"3"); 
 ok (${$C->_str($C->_rsft($x,$y,10))},1);
 $x = $C->_new(\"20000"); $y = $C->_new(\"3"); 
 ok (${$C->_str($C->_rsft($x,$y,10))},20);
 $x = $C->_new(\"256"); $y = $C->_new(\"4");
-if (!defined $C->_rsft($x,$y,2)) 
-  {
-  ok (1,1) 
-  }
-else
-  {
-  ok ('_rsft','undef');
-  }
+ok (${$C->_str($C->_rsft($x,$y,2))},256 >> 4);
 
 # _acmp
 $x = $C->_new(\"123456789");
@@ -146,11 +157,48 @@ ok (${$C->_str(scalar $C->_and($x,$y))},1);
 ok (${$C->_str(scalar $C->_from_hex(\"0xFf"))},255);
 ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11);
 
+# _as_hex, _as_bin
+ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"128"))))}, 128);
+ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"128"))))}, 128);
+
 # _check
 $x = $C->_new(\"123456789");
 ok ($C->_check($x),0);
 ok ($C->_check(123),'123 is not a reference');
 
+###############################################################################
+# _to_large and _to_small (last since they toy with BASE_LEN etc)
+
+exit if $Math::BigInt::Calc::VERSION < 0.19;
+
+$C->_base_len(5,7); $x = [ qw/67890 12345 67890 12345/ ]; $C->_to_large($x);
+ok (@$x,3);
+ok ($x->[0], '4567890'); ok ($x->[1], '7890123'); ok ($x->[2], '123456');
+
+$C->_base_len(5,7); $x = [ qw/54321 54321 54321 54321/ ]; $C->_to_large($x);
+ok (@$x,3);
+ok ($x->[0], '2154321'); ok ($x->[1], '4321543'); ok ($x->[2], '543215');
+
+$C->_base_len(6,7); $x = [ qw/654321 654321 654321 654321/ ];
+$C->_to_large($x); ok (@$x,4);
+ok ($x->[0], '1654321'); ok ($x->[1], '2165432');
+ok ($x->[2], '3216543'); ok ($x->[3], '654');
+
+$C->_base_len(5,7); $C->_to_small($x); ok (@$x,5);
+ok ($x->[0], '54321'); ok ($x->[1], '43216');
+ok ($x->[2], '32165'); ok ($x->[3], '21654');
+ok ($x->[4], '6543');
+
+$C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999/ ];
+$C->_to_large($x); ok (@$x,3);
+ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
+ok ($x->[2], '99999999');
+
+$C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999 99/ ];
+$C->_to_large($x); ok (@$x,3);
+ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
+ok ($x->[2], '9999999999');
+
 # done
 
 1;
index ad55d68..5d8bddb 100644 (file)
@@ -7,8 +7,7 @@ my $version = ${"$class\::VERSION"};
 
 package Math::Foo;
 
-use Math::BigInt;
-#use Math::BigInt lib => 'BitVect';    # for testing
+use Math::BigInt lib => $main::CL;
 use vars qw/@ISA/;
 @ISA = (qw/Math::BigInt/);
 
@@ -45,82 +44,80 @@ while (<DATA>)
   next if /^#/;        # skip comments
   if (s/^&//) 
     {
-    $f = $_;
+    $f = $_; next;
     }
   elsif (/^\$/) 
     {
-    $round_mode = $_;
-    $round_mode =~ s/^\$/$class\->/;
-    # print "$round_mode\n";
+    $round_mode = $_; $round_mode =~ s/^\$/$class\->/; next;
     }
-  else 
+
+  @args = split(/:/,$_,99); $ans = pop(@args);
+  $try = "\$x = $class->new(\"$args[0]\");";
+  if ($f eq "bnorm")
     {
-    @args = split(/:/,$_,99);
-    $ans = pop(@args);
-    $try = "\$x = $class->new(\"$args[0]\");";
-    if ($f eq "bnorm"){
-      $try = "\$x = $class->bnorm(\"$args[0]\");";
-    # some is_xxx tests
-    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) {
-      $try .= "\$x->$f();";
-    } elsif ($f eq "as_hex") {
-      $try .= '$x->as_hex();';
-    } elsif ($f eq "as_bin") {
-      $try .= '$x->as_bin();';
-    } elsif ($f eq "is_inf") {
-      $try .= "\$x->is_inf('$args[1]');";
-    } elsif ($f eq "binf") {
-      $try .= "\$x->binf('$args[1]');";
-    } elsif ($f eq "bone") {
-      $try .= "\$x->bone('$args[1]');";
-    # some unary ops
-    } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) {
-      $try .= "\$x->$f();";
-    }elsif ($f eq "length") {
-      $try .= '$x->length();';
-    }elsif ($f eq "exponent"){
-      # ->bstr() to see if an object is returned
-      $try .= '$x = $x->exponent()->bstr();';
-    }elsif ($f eq "mantissa"){
-      # ->bstr() to see if an object is returned
-      $try .= '$x = $x->mantissa()->bstr();';
-    }elsif ($f eq "parts"){
-      $try .= '($m,$e) = $x->parts();'; 
-      # ->bstr() to see if an object is returned
-      $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
-      $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
-      $try .= '"$m,$e";';
-    } else {
-      $try .= "\$y = $class->new('$args[1]');";
-      if ($f eq "bcmp"){
-        $try .= '$x <=> $y;';
-      }elsif ($f eq "bround") {
+    $try = "\$x = $class->bnorm(\"$args[0]\");";
+  # some is_xxx tests
+   } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) {
+    $try .= "\$x->$f();";
+   } elsif ($f eq "as_hex") {
+    $try .= '$x->as_hex();';
+   } elsif ($f eq "as_bin") {
+    $try .= '$x->as_bin();';
+   } elsif ($f eq "is_inf") {
+    $try .= "\$x->is_inf('$args[1]');";
+   } elsif ($f eq "binf") {
+    $try .= "\$x->binf('$args[1]');";
+   } elsif ($f eq "bone") {
+    $try .= "\$x->bone('$args[1]');";
+   # some unary ops
+   } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) {
+    $try .= "\$x->$f();";
+   } elsif ($f eq "length") {
+    $try .= '$x->length();';
+   } elsif ($f eq "exponent"){
+    # ->bstr() to see if an object is returned
+    $try .= '$x = $x->exponent()->bstr();';
+   } elsif ($f eq "mantissa"){
+    # ->bstr() to see if an object is returned
+    $try .= '$x = $x->mantissa()->bstr();';
+   } elsif ($f eq "parts"){
+    $try .= '($m,$e) = $x->parts();'; 
+    # ->bstr() to see if an object is returned
+    $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
+    $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
+    $try .= '"$m,$e";';
+   } else {
+    $try .= "\$y = $class->new('$args[1]');";
+    if ($f eq "bcmp")
+      {
+      $try .= '$x <=> $y;';
+      } elsif ($f eq "bround") {
       $try .= "$round_mode; \$x->bround(\$y);";
-      }elsif ($f eq "bacmp"){
-        $try .= '$x->bacmp($y);';
-      }elsif ($f eq "badd"){
-        $try .= '$x + $y;';
-      }elsif ($f eq "bsub"){
-        $try .= '$x - $y;';
-      }elsif ($f eq "bmul"){
-        $try .= '$x * $y;';
-      }elsif ($f eq "bdiv"){
-        $try .= '$x / $y;';
-      }elsif ($f eq "bdiv-list"){
-        $try .= 'join (",",$x->bdiv($y));';
+      } elsif ($f eq "bacmp"){
+      $try .= '$x->bacmp($y);';
+      } elsif ($f eq "badd"){
+      $try .= '$x + $y;';
+      } elsif ($f eq "bsub"){
+      $try .= '$x - $y;';
+      } elsif ($f eq "bmul"){
+      $try .= '$x * $y;';
+      } elsif ($f eq "bdiv"){
+      $try .= '$x / $y;';
+      } elsif ($f eq "bdiv-list"){
+      $try .= 'join (",",$x->bdiv($y));';
       # overload via x=
-      }elsif ($f =~ /^.=$/){
-        $try .= "\$x $f \$y;";
+      } elsif ($f =~ /^.=$/){
+      $try .= "\$x $f \$y;";
       # overload via x
-      }elsif ($f =~ /^.$/){
-        $try .= "\$x $f \$y;";
-      }elsif ($f eq "bmod"){
-        $try .= '$x % $y;';
-      }elsif ($f eq "bgcd")
+      } elsif ($f =~ /^.$/){
+      $try .= "\$x $f \$y;";
+      } elsif ($f eq "bmod"){
+      $try .= '$x % $y;';
+      } elsif ($f eq "bgcd")
         {
         if (defined $args[2])
           {
-          $try .= " \$z = $class->new(\"$args[2]\"); ";
+          $try .= " \$z = $class->new('$args[2]'); ";
           }
         $try .= "$class\::bgcd(\$x, \$y";
         $try .= ", \$z" if (defined $args[2]);
@@ -130,7 +127,7 @@ while (<DATA>)
         {
         if (defined $args[2])
           {
-          $try .= " \$z = $class->new(\"$args[2]\"); ";
+          $try .= " \$z = $class->new('$args[2]'); ";
           }
         $try .= "$class\::blcm(\$x, \$y";
         $try .= ", \$z" if (defined $args[2]);
@@ -162,31 +159,27 @@ while (<DATA>)
       }elsif ($f eq "bpow"){
         $try .= "\$x ** \$y;";
       }elsif ($f eq "digit"){
-        $try = "\$x = $class->new(\"$args[0]\"); \$x->digit($args[1]);";
+        $try = "\$x = $class->new('$args[0]'); \$x->digit($args[1]);";
       } else { warn "Unknown op '$f'"; }
+    } # end else all other ops
+
+  $ans1 = eval $try;
+  # convert hex/binary targets to decimal      
+  if ($ans =~ /^(0x0x|0b0b)/)
+    {
+    $ans =~ s/^0[xb]//; $ans = Math::BigInt->new($ans)->bstr();
     }
-   #  print "trying $try\n";
-    $ans1 = eval $try;
-    # remove leading '+' from target
-    $ans =~ s/^[+]([0-9])/$1/;                 
-    # convert hex/binary targets to decimal    
-    if ($ans =~ /^(0x0x|0b0b)/)
-      {
-      $ans =~ s/^0[xb]//;
-      $ans = Math::BigInt->new($ans)->bstr();
-      }
-    if ($ans eq "")
-      {
-      ok_undef ($ans1); 
-      }
-    else
-      {
-      # print "try: $try ans: $ans1 $ans\n";
-      print "# Tried: '$try'\n" if !ok ($ans1, $ans);
-      }
-    # check internal state of number objects
-    is_valid($ans1,$f) if ref $ans1; 
+  if ($ans eq "")
+    {
+    ok_undef ($ans1); 
+    }
+  else
+    {
+    # print "try: $try ans: $ans1 $ans\n";
+    print "# Tried: '$try'\n" if !ok ($ans1, $ans);
     }
+  # check internal state of number objects
+  is_valid($ans1,$f) if ref $ans1; 
   } # endwhile data tests
 close DATA;
 
@@ -427,7 +420,9 @@ $x -= 1; ok ($x,$MAX); is_valid($x);        # 9999 again
 
 $x = $class->new($BASE-1);     ok ($x->numify(),$BASE-1); 
 $x = $class->new(-($BASE-1));  ok ($x->numify(),-($BASE-1)); 
-$x = $class->new($BASE);       ok ($x->numify(),$BASE); 
+
+# +0 is to protect from 1e15 vs 100000000 (stupid to_string aaaarglburblll...)
+$x = $class->new($BASE);       ok ($x->numify()+0,$BASE+0);    
 $x = $class->new(-$BASE);      ok ($x->numify(),-$BASE);
 $x = $class->new( -($BASE*$BASE*1+$BASE*1+1) ); 
 ok($x->numify(),-($BASE*$BASE*1+$BASE*1+1)); 
@@ -454,18 +449,22 @@ ok ($x, 23456);
 ###############################################################################
 # bug in shortcut in mul()
 
-# construct a number with a zero-hole of BASE_LEN
-$x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
-$y = '1' x (2*$bl);
-$x = $class->new($x)->bmul($y);
-# result is 123..$bl .  $bl x (3*bl-1) . $bl...321 . '0' x $bl
-$y = ''; my $d = '';
-for (my $i = 1; $i <= $bl; $i++)
-  {
-  $y .= $i; $d = $i.$d;
-  }
-$y .= $bl x (3*$bl-1) . $d . '0' x $bl;
-ok ($x,$y);
+# construct a number with a zero-hole of BASE_LEN_SMALL
+{
+ my @bl = $CL->_base_len(); my $bl = $bl[4];
+
+ $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
+ $y = '1' x (2*$bl);
+ $x = $class->new($x)->bmul($y);
+ # result is 123..$bl .  $bl x (3*bl-1) . $bl...321 . '0' x $bl
+ $y = ''; my $d = '';
+ for (my $i = 1; $i <= $bl; $i++)
+   {
+   $y .= $i; $d = $i.$d;
+   }
+ $y .= $bl x (3*$bl-1) . $d . '0' x $bl;
+ ok ($x,$y);
+
 
 ###############################################################################
 # see if mul shortcut for small numbers works
@@ -475,32 +474,21 @@ $x = $class->new($x);
 # 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
 ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
 
+ }
+
 ###############################################################################
 # bug with rest "-0" in div, causing further div()s to fail
 
 $x = $class->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
 
-ok ($y,'0','not -0');  # not '-0'
-is_valid($y);
-
-###############################################################################
-# test whether bone/bzero take additional A & P, or reset it etc
-
-$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
-$x = $class->new(2); $x->binf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
-$x = $class->new(2); $x->bone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
-$x = $class->new(2); $x->bnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
-
-$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
-ok_undef ($x->{_a}); ok_undef ($x->{_p});
-$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
-ok_undef ($x->{_a}); ok_undef ($x->{_p});
+ok ($y,'0'); is_valid($y);     # $y not '-0'
 
-### all tests done ############################################################
+# all tests done
 
 1;
 
 ###############################################################################
+###############################################################################
 # Perl 5.005 does not like ok ($x,undef)
 
 sub ok_undef
@@ -636,7 +624,38 @@ NaN:-inf:
 0b001:1
 0b011:3
 0b101:5
-0b1000000000000000000000000000000:1073741824
+0b1001:9
+0b10001:17
+0b100001:33
+0b1000001:65
+0b10000001:129
+0b100000001:257
+0b1000000001:513
+0b10000000001:1025
+0b100000000001:2049
+0b1000000000001:4097
+0b10000000000001:8193
+0b100000000000001:16385
+0b1000000000000001:32769
+0b10000000000000001:65537
+0b100000000000000001:131073
+0b1000000000000000001:262145
+0b10000000000000000001:524289
+0b100000000000000000001:1048577
+0b1000000000000000000001:2097153
+0b10000000000000000000001:4194305
+0b100000000000000000000001:8388609
+0b1000000000000000000000001:16777217
+0b10000000000000000000000001:33554433
+0b100000000000000000000000001:67108865
+0b1000000000000000000000000001:134217729
+0b10000000000000000000000000001:268435457
+0b100000000000000000000000000001:536870913
+0b1000000000000000000000000000001:1073741825
+0b10000000000000000000000000000001:2147483649
+0b100000000000000000000000000000001:4294967297
+0b1000000000000000000000000000000001:8589934593
+0b10000000000000000000000000000000001:17179869185
 0b_101:NaN
 0b1_0_1:5
 0b0_0_0_1:1
@@ -651,6 +670,39 @@ NaN:-inf:
 0x1_2_3_4_56_78:305419896
 0xa_b_c_d_e_f:11259375
 0x_123:NaN
+0x9:9
+0x11:17
+0x21:33
+0x41:65
+0x81:129
+0x101:257
+0x201:513
+0x401:1025
+0x801:2049
+0x1001:4097
+0x2001:8193
+0x4001:16385
+0x8001:32769
+0x10001:65537
+0x20001:131073
+0x40001:262145
+0x80001:524289
+0x100001:1048577
+0x200001:2097153
+0x400001:4194305
+0x800001:8388609
+0x1000001:16777217
+0x2000001:33554433
+0x4000001:67108865
+0x8000001:134217729
+0x10000001:268435457
+0x20000001:536870913
+0x40000001:1073741825
+0x80000001:2147483649
+0x100000001:4294967297
+0x200000001:8589934593
+0x400000001:17179869185
+0x800000001:34359738369
 # inf input
 inf:inf
 +inf:inf
@@ -686,6 +738,19 @@ E23:NaN
 1e2e3:NaN
 1e2r:NaN
 1e2.0:NaN
+# leading zeros
+012:12
+0123:123
+01234:1234
+012345:12345
+0123456:123456
+01234567:1234567
+012345678:12345678
+0123456789:123456789
+01234567891:1234567891
+012345678912:12345678912
+0123456789123:123456789123
+01234567891234:1234567891234
 # normal input
 0:0
 +0:0
@@ -728,12 +793,12 @@ E23:NaN
 2:NaN
 abc:NaN
 &bone
-2:+:+1
+2:+:1
 2:-:-1
 boneNaN:-:-1
-boneNaN:+:+1
-2:abc:+1
-3::+1
+boneNaN:+:1
+2:abc:1
+3::1
 &binf
 1:+:inf
 2:-:-inf
@@ -759,27 +824,27 @@ NaN::0
 -infinity::0
 &blsft
 abc:abc:NaN
-+2:+2:+8
-+1:+32:+4294967296
-+1:+48:+281474976710656
++2:+2:8
++1:+32:4294967296
++1:+48:281474976710656
 +8:-2:NaN
 # excercise base 10
 +12345:4:10:123450000
 -1234:0:10:-1234
-+1234:0:10:+1234
++1234:0:10:1234
 +2:2:10:200
 +12:2:10:1200
 +1234:-3:10:NaN
 1234567890123:12:10:1234567890123000000000000
 &brsft
 abc:abc:NaN
-+8:+2:+2
-+4294967296:+32:+1
-+281474976710656:+48:+1
++8:+2:2
++4294967296:+32:1
++281474976710656:+48:1
 +2:-2:NaN
 # excercise base 10
 -1234:0:10:-1234
-+1234:0:10:+1234
++1234:0:10:1234
 +200:2:10:2
 +1234:3:10:1
 +1234:2:10:12
@@ -799,47 +864,47 @@ bnegNaN:NaN
 +inf:-inf
 -inf:inf
 abd:NaN
-+0:+0
-+1:-1
--1:+1
+0:0
+1:-1
+-1:1
 +123456789:-123456789
--123456789:+123456789
+-123456789:123456789
 &babs
 babsNaN:NaN
 +inf:inf
 -inf:inf
-+0:+0
-+1:+1
--1:+1
-+123456789:+123456789
--123456789:+123456789
+0:0
+1:1
+-1:1
++123456789:123456789
+-123456789:123456789
 &bcmp
 bcmpNaN:bcmpNaN:
-bcmpNaN:+0:
-+0:bcmpNaN:
-+0:+0:0
--1:+0:-1
-+0:-1:1
-+1:+0:1
-+0:+1:-1
--1:+1:-1
-+1:-1:1
+bcmpNaN:0:
+0:bcmpNaN:
+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
-+123:+123:0
-+123:+12:1
-+12:+123:-1
+1:1:0
+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
 -123:-124:1
 -124:-123:-1
-+100:+5:1
--123456789:+987654321:-1
+100:5:1
+-123456789:987654321:-1
 +123456789:-987654321:1
--987654321:+123456789:-1
+-987654321:123456789:-1
 -inf:5432112345:-1
 +inf:5432112345:1
 -inf:-5432112345:-1
@@ -861,19 +926,19 @@ NaN:-inf:
 abc:NaN
 +inf:inf
 -inf:-inf
-+0:+1
-+1:+2
--1:+0
++0:1
++1:2
+-1:0
 &bdec
 abc:NaN
 +inf:inf
 -inf:-inf
 +0:-1
-+1:+0
++1:0
 -1:-2
 &badd
 abc:abc:NaN
-abc:+0:NaN
+abc:0:NaN
 +0:abc:NaN
 +inf:-inf:0
 -inf:+inf:0
@@ -883,38 +948,38 @@ 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
+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
+-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
 &bsub
@@ -925,40 +990,40 @@ abc:+0:NaN
 -inf:+inf:-inf
 +inf:+inf:0
 -inf:-inf:0
-+0:+0:+0
-+1:+0:+1
++0:+0:0
++1:+0:1
 +0:+1:-1
-+1:+1:+0
++1:+1:0
 -1:+0:-1
-+0:-1:+1
--1:-1:+0
++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
++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
+-123456789:-987654321:864197532
++123456789:-987654321:1111111110
 &bmul
 abc:abc:NaN
 abc:+0:NaN
@@ -971,38 +1036,38 @@ NaNmul:-inf:NaN
 +inf:-inf:-inf
 -inf:+inf:-inf
 -inf:-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
++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
++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
-+25:+25:+625
-+12345:+12345:+152399025
-+99999:+11111:+1111088889
+-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
++25:+25:625
++12345:+12345:152399025
++99999:+11111:1111088889
 9999:10000:99990000
 99999:100000:9999900000
 999999:1000000:999999000000
@@ -1057,9 +1122,9 @@ inf:0:inf,inf
 0:0:NaN,NaN
 &bdiv
 abc:abc:NaN
-abc:+1:NaN
-+1:abc:NaN
-+0:+0:NaN
+abc:1:NaN
+1:abc:NaN
+0:0:NaN
 # inf handling (see table in doc)
 0:inf:0
 0:-inf:0
@@ -1086,38 +1151,38 @@ inf:0:inf
 -11:-2:5
 -11:2:-5
 11:-2:-5
-+0:+1:+0
-+0:-1:+0
-+1:+1:+1
--1:-1:+1
-+1:-1:-1
--1:+1:-1
-+1:+2:+0
-+2:+1:+2
-+1:+26:+0
-+1000000000:+9:+111111111
-+2000000000:+9:+222222222
-+3000000000:+9:+333333333
-+4000000000:+9:+444444444
-+5000000000:+9:+555555555
-+6000000000:+9:+666666666
-+7000000000:+9:+777777777
-+8000000000:+9:+888888888
-+9000000000:+9:+1000000000
-+35500000:+113:+314159
-+71000000:+226:+314159
-+106500000:+339:+314159
-+1000000000:+3:+333333333
-+10:+5:+2
-+100:+4:+25
-+1000:+8:+125
-+10000:+16:+625
-+999999999999:+9:+111111111111
-+999999999999:+99:+10101010101
-+999999999999:+999:+1001001001
-+999999999999:+9999:+100010001
-+999999999999999:+99999:+10000100001
-+1111088889:+99999:+11111
+0:1:0
+0:-1:0
+1:1:1
+-1:-1:1
+1:-1:-1
+-1:1:-1
+1:2:0
+2:1:2
+1:26:0
+1000000000:9:111111111
+2000000000:9:222222222
+3000000000:9:333333333
+4000000000:9:444444444
+5000000000:9:555555555
+6000000000:9:666666666
+7000000000:9:777777777
+8000000000:9:888888888
+9000000000:9:1000000000
+35500000:113:314159
+71000000:226:314159
+106500000:339:314159
+1000000000:3:333333333
++10:+5:2
++100:+4:25
++1000:+8:125
++10000:+16:625
+999999999999:9:111111111111
+999999999999:99:10101010101
+999999999999:999:1001001001
+999999999999:9999:100010001
+999999999999999:99999:10000100001
++1111088889:99999:11111
 -5:-3:1
 -5:3:-1
 4:3:1
@@ -1159,42 +1224,42 @@ inf:0:inf
 -8:0:-8
 0:0:NaN
 abc:abc:NaN
-abc:+1:abc:NaN
-+1:abc:NaN
-+0:+0:NaN
-+0:+1:+0
-+1:+0:+1
-+0:-1:+0
--1:+0:-1
-+1:+1:+0
--1:-1:+0
-+1:-1:+0
--1:+1:+0
-+1:+2:+1
-+2:+1:+0
-+1000000000:+9:+1
-+2000000000:+9:+2
-+3000000000:+9:+3
-+4000000000:+9:+4
-+5000000000:+9:+5
-+6000000000:+9:+6
-+7000000000:+9:+7
-+8000000000:+9:+8
-+9000000000:+9:+0
-+35500000:+113:+33
-+71000000:+226:+66
-+106500000:+339:+99
-+1000000000:+3:+1
-+10:+5:+0
-+100:+4:+0
-+1000:+8:+0
-+10000:+16:+0
-+999999999999:+9:+0
-+999999999999:+99:+0
-+999999999999:+999:+0
-+999999999999:+9999:+0
-+999999999999999:+99999:+0
--9:+5:+1
+abc:1:abc:NaN
+1:abc:NaN
+0:0:NaN
+0:1:0
+1:0:1
+0:-1:0
+-1:0:-1
+1:1:0
+-1:-1:0
+1:-1:0
+-1:1:0
+1:2:1
+2:1:0
+1000000000:9:1
+2000000000:9:2
+3000000000:9:3
+4000000000:9:4
+5000000000:9:5
+6000000000:9:6
+7000000000:9:7
+8000000000:9:8
+9000000000:9:0
+35500000:113:33
+71000000:226:66
+106500000:339:99
+1000000000:3:1
+10:5:0
+100:4:0
+1000:8:0
+10000:16:0
+999999999999:9:0
+999999999999:99:0
+999999999999:999:0
+999999999999:9999:0
+999999999999999:99999:0
+-9:+5:1
 +9:-5:-1
 -9:-5:-4
 -5:3:1
@@ -1212,37 +1277,37 @@ abc:+1:abc:NaN
 abc:abc:NaN
 abc:+0:NaN
 +0:abc:NaN
-+0:+0:+0
-+0:+1:+1
-+1:+0:+1
-+1:+1:+1
-+2:+3:+1
-+3:+2:+1
--3:+2:+1
-+100:+625:+25
-+4096:+81:+1
-+1034:+804:+2
-+27:+90:+56:+1
-+27:+90:+54:+9
++0:+0:0
++0:+1:1
++1:+0:1
++1:+1:1
++2:+3:1
++3:+2:1
+-3:+2:1
+100:625:25
+4096:81:1
+1034:804:2
+27:90:56:1
+27:90:54:9
 &blcm
 abc:abc:NaN
 abc:+0:NaN
 +0:abc:NaN
 +0:+0:NaN
-+1:+0:+0
-+0:+1:+0
-+27:+90:+270
-+1034:+804:+415668
++1:+0:0
++0:+1:0
++27:+90:270
++1034:+804:415668
 &band
 abc:abc:NaN
 abc:0:NaN
 0:abc:NaN
 1:2:0
 3:2:2
-+8:+2:+0
-+281474976710656:+0:+0
-+281474976710656:+1:+0
-+281474976710656:+281474976710656:+281474976710656
++8:+2:0
++281474976710656:0:0
++281474976710656:1:0
++281474976710656:+281474976710656:281474976710656
 -2:-3:-4
 -1:-1:-1
 -6:-6:-6
@@ -1271,10 +1336,10 @@ abc:abc:NaN
 abc:0:NaN
 0:abc:NaN
 1:2:3
-+8:+2:+10
-+281474976710656:+0:+281474976710656
-+281474976710656:+1:+281474976710657
-+281474976710656:+281474976710656:+281474976710656
++8:+2:10
++281474976710656:0:281474976710656
++281474976710656:1:281474976710657
++281474976710656:281474976710656:281474976710656
 -2:-3:-1
 -1:-1:-1
 -6:-6:-6
@@ -1317,10 +1382,10 @@ abc:abc:NaN
 abc:0:NaN
 0:abc:NaN
 1:2:3
-+8:+2:+10
-+281474976710656:+0:+281474976710656
-+281474976710656:+1:+281474976710657
-+281474976710656:+281474976710656:+0
++8:+2:10
++281474976710656:0:281474976710656
++281474976710656:1:281474976710657
++281474976710656:281474976710656:0
 -2:-3:3
 -1:-1:0
 -6:-6:0
@@ -1513,66 +1578,66 @@ NaNbround:12:NaN
 123456:4:123400
 123456:5:123450
 123456:6:123456
-+10123456789:5:+10123000000
++10123456789:5:10123000000
 -10123456789:5:-10123000000
-+10123456789:9:+10123456700
++10123456789:9:10123456700
 -10123456789:9:-10123456700
-+101234500:6:+101234000
++101234500:6:101234000
 -101234500:6:-101234000
-#+101234500:-4:+101234000
+#+101234500:-4:101234000
 #-101234500:-4:-101234000
 $round_mode('zero')
-+20123456789:5:+20123000000
++20123456789:5:20123000000
 -20123456789:5:-20123000000
-+20123456789:9:+20123456800
++20123456789:9:20123456800
 -20123456789:9:-20123456800
-+201234500:6:+201234000
++201234500:6:201234000
 -201234500:6:-201234000
-#+201234500:-4:+201234000
+#+201234500:-4:201234000
 #-201234500:-4:-201234000
 +12345000:4:12340000
 -12345000:4:-12340000
 $round_mode('+inf')
-+30123456789:5:+30123000000
++30123456789:5:30123000000
 -30123456789:5:-30123000000
-+30123456789:9:+30123456800
++30123456789:9:30123456800
 -30123456789:9:-30123456800
-+301234500:6:+301235000
++301234500:6:301235000
 -301234500:6:-301234000
-#+301234500:-4:+301235000
+#+301234500:-4:301235000
 #-301234500:-4:-301234000
 +12345000:4:12350000
 -12345000:4:-12340000
 $round_mode('-inf')
-+40123456789:5:+40123000000
++40123456789:5:40123000000
 -40123456789:5:-40123000000
-+40123456789:9:+40123456800
++40123456789:9:40123456800
 -40123456789:9:-40123456800
-+401234500:6:+401234000
-+401234500:6:+401234000
++401234500:6:401234000
++401234500:6:401234000
 #-401234500:-4:-401235000
 #-401234500:-4:-401235000
 +12345000:4:12340000
 -12345000:4:-12350000
 $round_mode('odd')
-+50123456789:5:+50123000000
++50123456789:5:50123000000
 -50123456789:5:-50123000000
-+50123456789:9:+50123456800
++50123456789:9:50123456800
 -50123456789:9:-50123456800
-+501234500:6:+501235000
++501234500:6:501235000
 -501234500:6:-501235000
-#+501234500:-4:+501235000
+#+501234500:-4:501235000
 #-501234500:-4:-501235000
 +12345000:4:12350000
 -12345000:4:-12350000
 $round_mode('even')
-+60123456789:5:+60123000000
++60123456789:5:60123000000
 -60123456789:5:-60123000000
-+60123456789:9:+60123456800
++60123456789:9:60123456800
 -60123456789:9:-60123456800
-+601234500:6:+601234000
++601234500:6:601234000
 -601234500:6:-601234000
-#+601234500:-4:+601234000
+#+601234500:-4:601234000
 #-601234500:-4:-601234000
 #-601234500:-9:0
 #-501234500:-9:0
index d1fac73..913c19b 100755 (executable)
@@ -10,7 +10,7 @@ BEGIN
   my $location = $0; $location =~ s/bigintpm.t//;
   unshift @INC, $location; # to locate the testing files
   chdir 't' if -d 't';
-  plan tests => 1865;
+  plan tests => 2005;
   }
 
 use Math::BigInt;
diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc
new file mode 100644 (file)
index 0000000..bdb1271
--- /dev/null
@@ -0,0 +1,703 @@
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes
+
+# Make sure you always quote any bare floating-point values, lest 123.46 will
+# be stringified to 123.4599999999 due to limited float prevision.
+
+my ($x,$y,$z,$u,$rc);
+
+###############################################################################
+# test defaults and set/get
+
+ok_undef (${"$mbi\::accuracy"});
+ok_undef (${"$mbi\::precision"});
+ok_undef ($mbi->accuracy());
+ok_undef ($mbi->precision());
+ok (${"$mbi\::div_scale"},40);
+ok (${"$mbi\::round_mode"},'even');
+ok ($mbi->round_mode(),'even');
+
+ok_undef (${"$mbf\::accuracy"});
+ok_undef (${"$mbf\::precision"});
+ok_undef ($mbf->precision());
+ok_undef ($mbf->precision());
+ok (${"$mbf\::div_scale"},40);
+ok (${"$mbf\::round_mode"},'even');
+ok ($mbf->round_mode(),'even');
+
+# accessors
+foreach my $class ($mbi,$mbf)
+  {
+  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/)
+  {
+  ok (${"$mbf\::accuracy"} = $_,$_);
+  ok (${"$mbi\::accuracy"} = $_,$_);
+  }
+ok_undef (${"$mbf\::accuracy"} = undef);
+ok_undef (${"$mbi\::accuracy"} = undef);
+
+# precision
+foreach (qw/5 42 -1 0/)
+  {
+  ok (${"$mbf\::precision"} = $_,$_);
+  ok (${"$mbi\::precision"} = $_,$_);
+  }
+ok_undef (${"$mbf\::precision"} = undef);
+ok_undef (${"$mbi\::precision"} = undef);
+
+# fallback
+foreach (qw/5 42 1/)
+  {
+  ok (${"$mbf\::div_scale"} = $_,$_);
+  ok (${"$mbi\::div_scale"} = $_,$_);
+  }
+# illegal values are possible for fallback due to no accessor
+
+# round_mode
+foreach (qw/odd even zero trunc +inf -inf/)
+  {
+  ok (${"$mbf\::round_mode"} = $_,$_);
+  ok (${"$mbi\::round_mode"} = $_,$_);
+  }
+${"$mbf\::round_mode"} = 'zero';
+ok (${"$mbf\::round_mode"},'zero');
+ok (${"$mbi\::round_mode"},'-inf');    # from above
+
+${"$mbi\::accuracy"} = undef;
+${"$mbi\::precision"} = undef;
+# local copies
+$x = $mbf->new('123.456');
+ok_undef ($x->accuracy());
+ok ($x->accuracy(5),5);
+ok_undef ($x->accuracy(undef),undef);
+ok_undef ($x->precision());
+ok ($x->precision(5),5);
+ok_undef ($x->precision(undef),undef);
+
+# see if MBF changes MBIs values
+ok (${"$mbi\::accuracy"} = 42,42);
+ok (${"$mbf\::accuracy"} = 64,64);
+ok (${"$mbi\::accuracy"},42);          # should be still 42
+ok (${"$mbf\::accuracy"},64);          # should be now 64
+
+###############################################################################
+# see if creating a number under set A or P will round it
+
+${"$mbi\::accuracy"} = 4;
+${"$mbi\::precision"} = undef;
+
+ok ($mbi->new(123456),123500);         # with A
+${"$mbi\::accuracy"} = undef;
+${"$mbi\::precision"} = 3;
+ok ($mbi->new(123456),123000);         # with P
+
+${"$mbf\::accuracy"} = 4;
+${"$mbf\::precision"} = undef;
+${"$mbi\::precision"} = undef;
+
+ok ($mbf->new('123.456'),'123.5');     # with A
+${"$mbf\::accuracy"} = undef;
+${"$mbf\::precision"} = -1;
+ok ($mbf->new('123.456'),'123.5');     # with P from MBF, not MBI!
+
+${"$mbf\::precision"} = undef;         # reset
+
+###############################################################################
+# see if MBI leaves MBF's private parts alone
+
+${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef;
+${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef;
+ok (Math::BigFloat->new('123.456'),'123.456');
+${"$mbi\::accuracy"} = undef;          # reset
+
+###############################################################################
+# see if setting accuracy/precision actually rounds the number
+
+$x = $mbf->new('123.456'); $x->accuracy(4);   ok ($x,'123.5');
+$x = $mbf->new('123.456'); $x->precision(-2); ok ($x,'123.46');
+
+$x = $mbi->new(123456);    $x->accuracy(4);   ok ($x,123500);
+$x = $mbi->new(123456);    $x->precision(2);  ok ($x,123500);
+
+###############################################################################
+# test actual rounding via round()
+
+$x = $mbf->new('123.456');
+ok ($x->copy()->round(5),'123.46');
+ok ($x->copy()->round(4),'123.5');
+ok ($x->copy()->round(5,2),'NaN');
+ok ($x->copy()->round(undef,-2),'123.46');
+ok ($x->copy()->round(undef,2),100);
+
+$x = $mbi->new('123');
+ok ($x->round(5,2),'NaN');
+
+$x = $mbf->new('123.45000');
+ok ($x->copy()->round(undef,-1,'odd'),'123.5');
+
+# see if rounding is 'sticky'
+$x = $mbf->new('123.4567');
+$y = $x->copy()->bround();             # no-op since nowhere A or P defined
+
+ok ($y,123.4567);                      
+$y = $x->copy()->round(5);
+ok ($y->accuracy(),5);
+ok_undef ($y->precision());            # A has precedence, so P still unset
+$y = $x->copy()->round(undef,2);
+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 = $mbf->new('123.4567');
+ok ($x,'123.4567');
+ok ($x->accuracy(4),4);
+ok ($x->precision(-2),-2);             # clear A
+ok_undef ($x->accuracy());
+
+$x = $mbf->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 = $mbf->new(123.456); $x->accuracy(4); $x->precision(2);
+$z = $x->copy(); ok_undef ($z->accuracy(),undef); ok ($z->precision(),2);
+
+# does accuracy()/precision work on zeros?
+foreach my $class ($mbi,$mbf)
+  {
+  $x = $class->bzero(); $x->accuracy(5); ok ($x->{_a},5);
+  $x = $class->bzero(); $x->precision(5); ok ($x->{_p},5);
+  $x = $class->new(0); $x->accuracy(5); ok ($x->{_a},5);
+  $x = $class->new(0); $x->precision(5); ok ($x->{_p},5);
+
+  $x = $class->bzero(); $x->round(5); ok ($x->{_a},5);
+  $x = $class->bzero(); $x->round(undef,5); ok ($x->{_p},5);
+  $x = $class->new(0); $x->round(5); ok ($x->{_a},5);
+  $x = $class->new(0); $x->round(undef,5); ok ($x->{_p},5);
+
+  # see if trying to increasing A in bzero() doesn't do something
+  $x = $class->bzero(); $x->{_a} = 3; $x->round(5); ok ($x->{_a},3);
+  }
+
+###############################################################################
+# test wether operations round properly afterwards
+# These tests are not complete, since they do not excercise every "return"
+# statement in the op's. But heh, it's better than nothing...
+
+$x = $mbf->new('123.456');
+$y = $mbf->new('654.321');
+$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y;          ok ($z,'777.8');
+$z = $y - $x;          ok ($z,'530.9');
+$z = $y * $x;          ok ($z,'80780');
+$z = $x ** 2;          ok ($z,'15241');
+$z = $x * $x;          ok ($z,'15241');
+
+# not: $z = -$x;               ok ($z,'-123.46'); ok ($x,'123.456');
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
+$x = $mbf->new(123456); $x->{_a} = 4;
+$z = $x->copy; $z++;   ok ($z,123500);
+
+$x = $mbi->new(123456);
+$y = $mbi->new(654321);
+$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y;          ok ($z,777800);
+$z = $y - $x;          ok ($z,530900);
+$z = $y * $x;          ok ($z,80780000000);
+$z = $x ** 2;          ok ($z,15241000000);
+# not yet: $z = -$x;           ok ($z,-123460); ok ($x,123456);
+$z = $x->copy; $z++;   ok ($z,123460);
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
+
+$x = $mbi->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) directly
+$x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->babs(),123401);
+$x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->bneg(),123401);
+
+# test fdiv rounding to A and R (bug in v1.48 and maybe earlier versions)
+$mbf->round_mode('even');
+$x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); ok ($x,'123.4');
+
+###############################################################################
+# test mixed arguments
+
+$x = $mbf->new(10);
+$u = $mbf->new(2.5);
+$y = $mbi->new(2);
+
+$z = $x + $y; ok ($z,12); ok (ref($z),$mbf);
+$z = $x / $y; ok ($z,5); ok (ref($z),$mbf);
+$z = $u * $y; ok ($z,5); ok (ref($z),$mbf);
+
+$y = $mbi->new(12345);
+$z = $u->copy()->bmul($y,2,undef,'odd'); ok ($z,31000);
+$z = $u->copy()->bmul($y,3,undef,'odd'); ok ($z,30900);
+$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
+$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
+$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
+
+# breakage:
+# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
+# $z = $y * $u; ok ($z,5); ok (ref($z),$mbi);
+# $z = $y + $x; ok ($z,12); ok (ref($z),$mbi);
+# $z = $y / $x; ok ($z,0); ok (ref($z),$mbi);
+
+###############################################################################
+# rounding in bdiv with fallback and already set A or P
+
+${"$mbf\::accuracy"} = undef;
+${"$mbf\::precision"} = undef;
+${"$mbf\::div_scale"} = 40;
+
+$x = $mbf->new(10); $x->{_a} = 4;
+ok ($x->bdiv(3),'3.333');
+ok ($x->{_a},4);                       # set's it since no fallback
+
+$x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3);
+ok ($x->bdiv($y),'3.333');
+ok ($x->{_a},4);                       # set's it since no fallback
+
+# rounding to P of x
+$x = $mbf->new(10); $x->{_p} = -2;
+ok ($x->bdiv(3),'3.33');
+
+# round in div with requested P
+$x = $mbf->new(10);
+ok ($x->bdiv(3,undef,-2),'3.33');
+
+# round in div with requested P greater than fallback
+${"$mbf\::div_scale"} = 5;
+$x = $mbf->new(10);
+ok ($x->bdiv(3,undef,-8),'3.33333333');
+${"$mbf\::div_scale"} = 40;
+
+$x = $mbf->new(10); $y = $mbf->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 = $mbf->new(10); $y = $mbf->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 = $mbf->new(1); $x->bround(-2); };
+ok ($@ =~ /^bround\(\) needs positive accuracy/,1);
+
+# test whether rounding to higher accuracy is no-op
+$x = $mbf->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 = $mbi->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 = $mbi->new(12345);
+$x->bround(-1);
+ok ($x,'12300');
+ok ($x->{_a},4);
+# bround(-n) should set _a
+$x = $mbi->new(12345);
+$x->bround(-2);
+ok ($x,'12000');
+ok ($x->{_a},3);
+# bround(-n) should set _a
+$x = $mbi->new(12345); $x->{_a} = 5;
+$x->bround(-3);
+ok ($x,'10000');
+ok ($x->{_a},2);
+# bround(-n) should set _a
+$x = $mbi->new(12345); $x->{_a} = 5;
+$x->bround(-4);
+ok ($x,'0');
+ok ($x->{_a},1);
+
+# bround(-n) should be noop if n too big
+$x = $mbi->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 = $mbi->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 = $mbi->new(54321); $x->{_a} = 5;
+$x->bround(-6);
+ok ($x,'100000');              # no-op
+ok ($x->{_a},0);
+# bround(n) should set _a
+$x = $mbi->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 = $mbi->new(12345); $x->{_a} = 5;
+$x->bround(6);                  # must be no-op
+ok ($x,'12345');
+
+$x = $mbf->new('0.0061'); $x->bfround(-2);
+ok ($x,'0.01');
+
+# MBI::bfround should clear A for negative P
+$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
+ok_undef ($x->{_a});
+
+###############################################################################
+# rounding with already set precision/accuracy
+
+$x = $mbf->new(1); $x->{_p} = -5;
+ok ($x,'1.00000');
+
+# further rounding donw
+ok ($x->bfround(-2),'1.00');
+ok ($x->{_p},-2);
+
+$x = $mbf->new(12345); $x->{_a} = 5;
+ok ($x->bround(2),'12000');
+ok ($x->{_a},2);
+
+$x = $mbf->new('1.2345'); $x->{_a} = 5;
+ok ($x->bround(2),'1.2');
+ok ($x->{_a},2);
+
+# mantissa/exponent format and A/P
+$x = $mbf->new('12345.678'); $x->accuracy(4);
+ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
+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 = $mbf->new(100) / 3;
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+# result & reminder
+$x = $mbf->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 = $mbf->new(12345); $x->accuracy(4);                # '12340'
+$y = $mbf->new(12345); $y->accuracy(2);                # '12000'
+ok ($x+$y,24000);                              # 12340+12000=> 24340 => 24000
+
+$x = $mbf->new(54321); $x->accuracy(4);                # '12340'
+$y = $mbf->new(12345); $y->accuracy(3);                # '12000'
+ok ($x-$y,42000);                              # 54320+12300=> 42020 => 42000
+
+$x = $mbf->new('1.2345'); $x->precision(-2);   # '1.23'
+$y = $mbf->new('1.2345'); $y->precision(-4);   # '1.2345'
+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
+${"$mbi\::accuracy"} = undef;
+${"$mbi\::precision"} = undef;
+${"$mbi\::div_scale"} = 40;
+${"$mbi\::round_mode"} = 'odd';
+$x = $mbi->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,1);                         # error, A and P defined
+ok ($params[0],$x);                            # self
+
+${"$mbi\::accuracy"} = 1;
+@params = $x->_find_round_parameters(undef,-2);
+ok (scalar @params,1);                         # error, A and P defined
+ok ($params[0],$x);                            # self
+
+${"$mbi\::accuracy"} = undef;
+${"$mbi\::precision"} = 1;
+@params = $x->_find_round_parameters(1,undef);
+ok (scalar @params,1);                         # error, A and P defined
+ok ($params[0],$x);                            # self
+
+${"$mbi\::precision"} = undef;                 # reset
+
+###############################################################################
+# test whether bone/bzero take additional A & P, or reset it etc
+
+foreach my $class ($mbi,$mbf)
+  {
+  $x = $class->new(2)->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+  $x = $class->new(2)->bone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+  $x = $class->new(2)->binf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+  $x = $class->new(2)->bnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+  $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
+  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+  $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
+  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+  $x = $class->new(2,1); ok ($x->{_a},1); ok_undef ($x->{_p});
+  $x = $class->new(2,undef,1); ok_undef ($x->{_a}); ok ($x->{_p},1);
+  
+  $x = $class->new(2,1)->bzero(); ok ($x->{_a},1); ok_undef ($x->{_p});
+  $x = $class->new(2,undef,1)->bzero(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+
+  $x = $class->new(2,1)->bone(); ok ($x->{_a},1); ok_undef ($x->{_p});
+  $x = $class->new(2,undef,1)->bone(); ok_undef ($x->{_a}); ok ($x->{_p},1);
+  }
+
+###############################################################################
+# check whether mixing A and P creates a NaN
+
+# new with set accuracy/precision and with parameters
+
+foreach my $class ($mbi,$mbf)
+  {
+  ok ($class->new(123,4,-3),'NaN');            # with parameters
+  ${"$class\::accuracy"} = 42;
+  ${"$class\::precision"} = 2;
+  ok ($class->new(123),'NaN');                 # with globals
+  ${"$class\::accuracy"} = undef;
+  ${"$class\::precision"} = undef;
+  }
+
+# binary ops
+foreach my $class ($mbi,$mbf)
+  {
+  foreach (qw/add sub mul pow mod/)
+  #foreach (qw/add sub mul div pow mod/)
+    {
+    my $try = "my \$x = $class->new(1234); \$x->accuracy(5); ";
+      $try .= "my \$y = $class->new(12); \$y->precision(-3); ";
+      $try .= "\$x->b$_(\$y);";
+    $rc = eval $try;
+    print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
+    }
+  }
+
+# unary ops
+foreach (qw/new bsqrt/)
+  {
+  my $try = 'my $x = $mbi->$_(1234,5,-3); ';
+  $rc = eval $try;
+  print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
+  }
+
+###############################################################################
+# test whether shortcuts returning zero/one preserve A and P
+
+my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args);
+my $CALC = Math::BigInt::_core_lib();
+while (<DATA>)
+  {
+  chop;
+  next if /^\s*(#|$)/; # skip comments and empty lines
+  if (s/^&//)
+    {
+    $f = $_; next;     # function
+    }
+  @args = split(/:/,$_,99);
+  my $ans = pop(@args);
+
+  ($x,$xa,$xp) = split (/,/,$args[0]);
+  $xa = $xa || ''; $xp = $xp || '';
+  $try  = "\$x = $mbi->new('$x'); ";
+  $try .= "\$x->accuracy($xa); " if $xa ne '';
+  $try .= "\$x->precision($xp); " if $xp ne '';
+
+  ($y,$ya,$yp) = split (/,/,$args[1]);
+  $ya = $ya || ''; $yp = $yp || '';
+  $try .= "\$y = $mbi->new('$y'); ";
+  $try .= "\$y->accuracy($ya); " if $ya ne '';
+  $try .= "\$y->precision($yp); " if $yp ne '';
+  
+  $try .= "\$x->$f(\$y);";
+  
+  #  print "trying $try\n";
+  $rc = eval $try;
+  # convert hex/binary targets to decimal
+  if ($ans =~ /^(0x0x|0b0b)/)
+    {
+    $ans =~ s/^0[xb]//;
+    $ans = $mbi->new($ans)->bstr();
+    }
+  print "# Tried: '$try'\n" if !ok ($rc, $ans);
+  # check internal state of number objects
+  is_valid($rc,$f) if ref $rc;
+
+  # now check whether A and P are set correctly
+  # only one of $a or $p will be set (no crossing here)
+  $a = $xa || $ya; $p = $xp || $yp;
+
+  # print "Check a=$a p=$p\n";
+  print "# Tried: '$try'\n";
+  ok ($x->{_a}, $a) && ok_undef ($x->{_p}) if $a ne ''; 
+  ok ($x->{_p}, $p) && ok_undef ($x->{_a}) if $p ne ''; 
+  }
+
+# all done
+1;
+
+###############################################################################
+###############################################################################
+# 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');
+  print "# Called from ",join(' ',caller()),"\n";
+  }
+
+###############################################################################
+# sub to check validity of a BigInt internally, to ensure that no op leaves a
+# number object in an invalid state (f.i. "-0")
+
+sub is_valid
+  {
+  my ($x,$f) = @_;
+
+  my $e = 0;                    # error?
+  # ok as reference?
+  $e = 'Not a reference' if !ref($x);
+
+  # has ok sign?
+  $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
+   if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+
+  $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
+  $e = $CALC->_check($x->{value}) if $e eq '0';
+
+  # test done, see if error did crop up
+  ok (1,1), return if ($e eq '0');
+
+  ok (1,$e." after op '$f'");
+  } 
+
+# format is:
+# x,A,P:x,A,P:result
+# 123,,3 means 123 with precision 3 (A is undef)
+# the A or P of the result is calculated automatically
+__DATA__
+&badd
+# bsub uses badd anyway, so it should be right
+123,,:123,,:246
+123,3,:0,,:123
+123,,-3:0,,:123
+123,,:0,3,:123
+123,,:0,,-3:123
+&bmul
+123,,:1,,:123
+123,3,:0,,:0
+123,,-3:0,,:0
+123,,:0,3,:0
+123,,:0,,-3:0
+123,3,:1,,:123
+123,,-3:1,,:123
+123,,:1,3,:123
+123,,:1,,-3:123
+1,3,:123,,:123
+1,,-3:123,,:123
+1,,:123,3,:123
+1,,:123,,-3:123
+&bdiv
+123,,:1,,:123
+123,4,:1,,:123
+123,,:1,4,:123
+123,,:1,,-4:123
+123,,-4:1,,:123
+1,4,:123,,:0
+1,,:123,4,:0
+1,,:123,,-4:0
+1,,-4:123,,:0
index 976bb9b..af3e4cf 100644 (file)
 # test rounding, accuracy, precicion and fallback, round_mode and mixing
 # of classes
 
-# Make sure you always quote any bare floating-point values, lest 123.46 will
-# be stringified to 123.4599999999 due to limited float prevision.
-
 use strict;
 use Test;
 
-BEGIN 
+BEGIN
   {
   $| = 1;
-  chdir 't' if -d 't';
-  unshift @INC, '../lib'; # for running manually
-  plan tests => 260;
-  }
-
-# 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;
+  # to locate the testing files
+  my $location = $0; $location =~ s/mbimbf.t//i;
+  if ($ENV{PERL_CORE})
+    {
+    @INC = qw(../lib);                 # testing with the core distribution
+    }
+  else
+    {
+    unshift @INC, '../lib';    # for testing manually
+    }
+  if (-d 't')
+    {
+    chdir 't';
+    require File::Spec;
+    unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+    }
+  else
+    {
+    unshift @INC, $location;
+    }
+  print "# INC = @INC\n";
+
+  plan tests => 428 
+    + 8;               # own test
   }
 
-sub bfround
-  {
-  my ($self,$p,$r) = @_;
-  $self->{value} = 'p' x $p;
-  return $self;
-  }
+use Math::BigInt 1.49;
+use Math::BigFloat 1.26;
 
-package main;
+use vars qw/$mbi $mbf/;
 
-use Math::BigInt;
-use Math::BigFloat;
+$mbi = 'Math::BigInt';
+$mbf = 'Math::BigFloat';
 
-my ($x,$y,$z,$u);
+require 'mbimbf.inc';
 
-###############################################################################
-# test defaults and set/get
+# some tests that won't work with subclasses, since the things are only
+# garantied in the Math::BigInt/BigFloat (unless subclass chooses to support
+# this)
 
-ok_undef ($Math::BigInt::accuracy);
-ok_undef ($Math::BigInt::precision);
-ok_undef (Math::BigInt::accuracy());
-ok_undef (Math::BigInt::precision());
-ok_undef (Math::BigInt->accuracy());
-ok_undef (Math::BigInt->precision());
-ok ($Math::BigInt::div_scale,40);
-ok (Math::BigInt::div_scale(),40);
-ok ($Math::BigInt::round_mode,'even');
-ok (Math::BigInt::round_mode(),'even');
-ok (Math::BigInt->round_mode(),'even');
+Math::BigInt->round_mode('even');      # reset for tests
+Math::BigFloat->round_mode('even');    # reset for tests
 
-ok_undef ($Math::BigFloat::accuracy);
-ok_undef ($Math::BigFloat::precision);
-ok_undef (Math::BigFloat::accuracy());
-ok_undef (Math::BigFloat::accuracy());
-ok_undef (Math::BigFloat->precision());
-ok_undef (Math::BigFloat->precision());
-ok ($Math::BigFloat::div_scale,40);
-ok (Math::BigFloat::div_scale(),40);
-ok ($Math::BigFloat::round_mode,'even');
-ok (Math::BigFloat::round_mode(),'even');
-ok (Math::BigFloat->round_mode(),'even');
-
-# old way
 ok ($Math::BigInt::rnd_mode,'even');
 ok ($Math::BigFloat::rnd_mode,'even');
 
-$x = eval 'Math::BigInt->round_mode("huhmbi");';
+my $x = eval '$mbi->round_mode("huhmbi");';
 ok ($@ =~ /^Unknown round mode huhmbi at/);
 
-$x = eval 'Math::BigFloat->round_mode("huhmbf");';
+$x = eval '$mbf->round_mode("huhmbf");';
 ok ($@ =~ /^Unknown round mode huhmbf at/);
 
 # old way (now with test for validity)
 $x = eval '$Math::BigInt::rnd_mode = "huhmbi";';
 ok ($@ =~ /^Unknown round mode huhmbi at/);
-$x = eval '$Math::BigFloat::rnd_mode = "huhmbi";';
-ok ($@ =~ /^Unknown round mode huhmbi at/);
+$x = eval '$Math::BigFloat::rnd_mode = "huhmbf";';
+ok ($@ =~ /^Unknown round mode huhmbf at/);
 # see if accessor also changes old variable
-Math::BigInt->round_mode('odd');
-ok ($Math::BigInt::rnd_mode,'odd');
-Math::BigFloat->round_mode('odd');
-ok ($Math::BigFloat::rnd_mode,'odd');
-
-Math::BigInt->round_mode('even');
-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/)
-  {
-  ok ($Math::BigFloat::accuracy = $_,$_);
-  ok ($Math::BigInt::accuracy = $_,$_);
-  }
-ok_undef ($Math::BigFloat::accuracy = undef);
-ok_undef ($Math::BigInt::accuracy = undef);
-
-# precision
-foreach (qw/5 42 -1 0/)
-  {
-  ok ($Math::BigFloat::precision = $_,$_);
-  ok ($Math::BigInt::precision = $_,$_);
-  }
-ok_undef ($Math::BigFloat::precision = undef);
-ok_undef ($Math::BigInt::precision = undef);
-
-# fallback
-foreach (qw/5 42 1/)
-  {
-  ok ($Math::BigFloat::div_scale = $_,$_);
-  ok ($Math::BigInt::div_scale = $_,$_);
-  }
-# illegal values are possible for fallback due to no accessor
-
-# round_mode
-foreach (qw/odd even zero trunc +inf -inf/)
-  {
-  ok ($Math::BigFloat::round_mode = $_,$_);
-  ok ($Math::BigInt::round_mode = $_,$_);
-  }
-$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;
-# local copies
-$x = Math::BigFloat->new('123.456');
-ok_undef ($x->accuracy());
-ok ($x->accuracy(5),5);
-ok_undef ($x->accuracy(undef),undef);
-ok_undef ($x->precision());
-ok ($x->precision(5),5);
-ok_undef ($x->precision(undef),undef);
-
-# see if MBF changes MBIs values
-ok ($Math::BigInt::accuracy = 42,42);
-ok ($Math::BigFloat::accuracy = 64,64);
-ok ($Math::BigInt::accuracy,42);               # should be still 42
-ok ($Math::BigFloat::accuracy,64);             # should be still 64
-
-###############################################################################
-# see if creating a number under set A or P will round it
-
-$Math::BigInt::accuracy = 4;
-$Math::BigInt::precision = 3;
-
-ok (Math::BigInt->new(123456),123500); # with A
-$Math::BigInt::accuracy = undef;
-ok (Math::BigInt->new(123456),123000); # with P
-
-$Math::BigFloat::accuracy = 4;
-$Math::BigFloat::precision = -1;
-$Math::BigInt::precision = undef;
-
-ok (Math::BigFloat->new('123.456'),'123.5');   # with A
-$Math::BigFloat::accuracy = undef;
-ok (Math::BigFloat->new('123.456'),'123.5');   # with P from MBF, not MBI!
-
-$Math::BigFloat::precision = undef;
-
-###############################################################################
-# see if setting accuracy/precision actually rounds the number
-
-$x = Math::BigFloat->new('123.456'); $x->accuracy(4);   ok ($x,'123.5');
-$x = Math::BigFloat->new('123.456'); $x->precision(-2); ok ($x,'123.46');
-
-$x = Math::BigInt->new(123456);      $x->accuracy(4);   ok ($x,123500);
-$x = Math::BigInt->new(123456);      $x->precision(2);  ok ($x,123500);
-
-###############################################################################
-# test actual rounding via round()
-
-$x = Math::BigFloat->new('123.456');
-ok ($x->copy()->round(5,2),'123.46');
-ok ($x->copy()->round(4,2),'123.5');
-ok ($x->copy()->round(undef,-2),'123.46');
-ok ($x->copy()->round(undef,2),100);
-
-$x = Math::BigFloat->new('123.45000');
-ok ($x->copy()->round(undef,-1,'odd'),'123.5');
-
-# see if rounding is 'sticky'
-$x = Math::BigFloat->new('123.4567');
-$y = $x->copy()->bround();             # no-op since nowhere A or P defined
-
-ok ($y,123.4567);                      
-$y = $x->copy()->round(5,2);
-ok ($y->accuracy(),5);
-ok_undef ($y->precision());            # A has precedence, so P still unset
-$y = $x->copy()->round(undef,2);
-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_undef ($z->accuracy(),undef); ok ($z->precision(),2);
-
-###############################################################################
-# test wether operations round properly afterwards
-# These tests are not complete, since they do not excercise every "return"
-# statement in the op's. But heh, it's better than nothing...
-
-$x = Math::BigFloat->new('123.456');
-$y = Math::BigFloat->new('654.321');
-$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
-$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
-
-$z = $x + $y;          ok ($z,'777.8');
-$z = $y - $x;          ok ($z,'530.9');
-$z = $y * $x;          ok ($z,'80780');
-$z = $x ** 2;          ok ($z,'15241');
-$z = $x * $x;          ok ($z,'15241');
-
-# not: $z = -$x;               ok ($z,'-123.46'); ok ($x,'123.456');
-$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
-$x = Math::BigFloat->new(123456); $x->{_a} = 4;
-$z = $x->copy; $z++;   ok ($z,123500);
-
-$x = Math::BigInt->new(123456);
-$y = Math::BigInt->new(654321);
-$x->{_a} = 5;          # $x->accuracy(5) would round $x straightaway
-$y->{_a} = 4;          # $y->accuracy(4) would round $x straightaway
-
-$z = $x + $y;          ok ($z,777800);
-$z = $y - $x;          ok ($z,530900);
-$z = $y * $x;          ok ($z,80780000000);
-$z = $x ** 2;          ok ($z,15241000000);
-# not yet: $z = -$x;           ok ($z,-123460); ok ($x,123456);
-$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
-
-$x = Math::BigFloat->new(10);
-$u = Math::BigFloat->new(2.5);
-$y = Math::BigInt->new(2);
-
-$z = $x + $y; ok ($z,12); ok (ref($z),'Math::BigFloat');
-$z = $x / $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
-$z = $u * $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
-
-$y = Math::BigInt->new(12345);
-$z = $u->copy()->bmul($y,2,0,'odd'); ok ($z,31000);
-$z = $u->copy()->bmul($y,3,0,'odd'); ok ($z,30900);
-$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
-$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
-$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
-
-# breakage:
-# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
-# $z = $y * $u; ok ($z,5); ok (ref($z),'Math::BigInt');
-# $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
-
-###############################################################################
-# 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');
-  }
+$mbi->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
+$mbf->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
 
diff --git a/lib/Math/BigInt/t/require.t b/lib/Math/BigInt/t/require.t
new file mode 100644 (file)
index 0000000..f98dbeb
--- /dev/null
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN
+  {
+  $| = 1;
+  chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 1;
+  } 
+
+my ($try,$ans,$x);
+
+require Math::BigInt; $x = Math::BigInt->new(1); ++$x;
+
+#$try = 'require Math::BigInt; $x = Math::BigInt->new(1); ++$x;';
+#$ans = eval $try || 'undef';
+#print "# For '$try'\n" if (!ok "$ans" , '2' ); 
+
+ok ($x||'undef',2);
+
+# all tests done
+
+1;
+
index 937a9c6..92d04e8 100755 (executable)
@@ -26,7 +26,8 @@ BEGIN
     }
   print "# INC = @INC\n"; 
   
-  plan tests => 1367 + 4;      # + 4 own tests
+  plan tests => 1528
+    + 4;       # + 4 own tests
   }
 
 use Math::BigFloat::Subclass;
index 779416c..eeedafe 100755 (executable)
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1865
+  plan tests => 2005
     + 4;       # +4 own tests
   }
 
diff --git a/lib/Math/BigInt/t/sub_mif.t b/lib/Math/BigInt/t/sub_mif.t
new file mode 100644 (file)
index 0000000..01b87db
--- /dev/null
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -w
+
+# test rounding, accuracy, precicion and fallback, round_mode and mixing
+# of classes
+
+use strict;
+use Test;
+
+BEGIN
+  {
+  $| = 1;
+  # to locate the testing files
+  my $location = $0; $location =~ s/sub_mif.t//i;
+  if ($ENV{PERL_CORE})
+    {
+    @INC = qw(../t/lib);               # testing with the core distribution
+    }
+  unshift @INC, '../lib';      # for testing manually
+  if (-d 't')
+    {
+    chdir 't';
+    require File::Spec;
+    unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+    }
+  else
+    {
+    unshift @INC, $location;
+    }
+  print "# INC = @INC\n";
+  
+  plan tests => 428;
+  }
+
+use Math::BigInt::Subclass;
+use Math::BigFloat::Subclass;
+
+use vars qw/$mbi $mbf/;
+
+$mbi = 'Math::BigInt::Subclass';
+$mbf = 'Math::BigFloat::Subclass';
+
+require 'mbimbf.inc';
+
diff --git a/lib/Math/BigInt/t/use.t b/lib/Math/BigInt/t/use.t
new file mode 100644 (file)
index 0000000..c525098
--- /dev/null
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+# use Module(); doesn't call impor() - thanx for cpan test David. M. Town and
+# Andreas Marcel Riechert for spotting it. It is fixed by the same code that
+# fixes require Math::BigInt, but we make a test to be sure it really works.
+
+use strict;
+use Test;
+
+BEGIN
+  {
+  $| = 1;
+  chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 1;
+  } 
+
+my ($try,$ans,$x);
+
+use Math::BigInt(); $x = Math::BigInt->new(1); ++$x;
+
+ok ($x||'undef',2);
+
+# all tests done
+
+1;
+
index 209aa1d..ca9bbce 100644 (file)
@@ -6,13 +6,13 @@ require 5.005_02;
 use strict;
 
 use Exporter;
-use Math::BigFloat(1.23);
+use Math::BigFloat(1.27);
 use vars qw($VERSION @ISA $PACKAGE
             $accuracy $precision $round_mode $div_scale);
 
 @ISA = qw(Exporter Math::BigFloat);
 
-$VERSION = 0.01;
+$VERSION = 0.02;
 
 # Globals
 $accuracy = $precision = undef;
@@ -25,12 +25,11 @@ sub new
         my $class  = ref($proto) || $proto;
 
         my $value       = shift;
-       # Set to 0 if not provided, but don't use || (this would trigger for
-       # a passed objects to see if they are zero)
-       $value  = 0 if !defined $value;   
-
+       my $a = $accuracy; $a = $_[0] if defined $_[0];
+       my $p = $precision; $p = $_[1] if defined $_[1];
         # Store the floating point value
-        my $self = bless Math::BigFloat->new($value), $class;
+        my $self = Math::BigFloat->new($value,$a,$p,$round_mode);
+        bless $self, $class;
         $self->{'_custom'} = 1; # make sure this never goes away
         return $self;
 }
index 9cc7e94..7c56c4e 100644 (file)
@@ -14,13 +14,14 @@ $VERSION = '0.02';
 
 # uses Calc, but only features the strictly necc. methods.
 
-use Math::BigInt::Calc v0.17;
+use Math::BigInt::Calc '0.18';
 
 BEGIN
   {
   foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec
                acmp len digit zeros
                is_zero is_one is_odd is_even is_one check
+               to_small to_large
                /)
     {
     my $name  = "Math::BigInt::Calc::_$_";
index 3656b9f..03795da 100644 (file)
@@ -6,14 +6,14 @@ require 5.005_02;
 use strict;
 
 use Exporter;
-use Math::BigInt(1.45);
+use Math::BigInt(1.49);
 use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK
             $accuracy $precision $round_mode $div_scale);
 
 @ISA = qw(Exporter Math::BigInt);
 @EXPORT_OK = qw(bgcd);
 
-$VERSION = 0.01;
+$VERSION = 0.02;
 
 # Globals
 $accuracy = $precision = undef;
@@ -26,10 +26,10 @@ sub new
         my $class  = ref($proto) || $proto;
 
         my $value       = shift;
-       $value          = 0 if !defined $value;         # no || 0 here!
-
-        # Store the floating point value
-        my $self = bless Math::BigInt->new($value), $class;
+       my $a = $accuracy; $a = $_[0] if defined $_[0];
+       my $p = $precision; $p = $_[1] if defined $_[1];
+        my $self = Math::BigInt->new($value,$a,$p,$round_mode);
+       bless $self,$class;
         $self->{'_custom'} = 1; # make sure this never goes away
         return $self;
 }
@@ -47,7 +47,6 @@ sub blcm
 sub import
   {
   my $self = shift;
-#  Math::BigInt->import(@_);
   $self->SUPER::import(@_);                     # need it for subclasses
   #$self->export_to_level(1,$self,@_);           # need this ?
   }