This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Math::BigInt 1.45; from Tels.
authorJarkko Hietaniemi <jhi@iki.fi>
Sun, 4 Nov 2001 16:52:45 +0000 (16:52 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 4 Nov 2001 16:52:45 +0000 (16:52 +0000)
NOTE: some of the tests are failing but that's because
the core integration is not yet done.

p4raw-id: //depot/perl@12843

MANIFEST
lib/Math/BigInt.pm
lib/Math/BigInt/Calc.pm
lib/Math/BigInt/t/Math/BigFloat/Subclass.pm [moved from lib/Math/BigInt/t/Math/Subclass.pm with 77% similarity]
lib/Math/BigInt/t/Math/BigInt/Subclass.pm [new file with mode: 0644]
lib/Math/BigInt/t/bigfltpm.t
lib/Math/BigInt/t/calling.t
lib/Math/BigInt/t/mbimbf.t
lib/Math/BigInt/t/sub_mbf.t [moved from lib/Math/BigInt/t/subclass.t with 72% similarity, mode: 0755]
lib/Math/BigInt/t/sub_mbi.t [new file with mode: 0755]

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