From: Tels <nospam-abuse@bloodgate.com>
Date: Wed, 27 Jun 2007 18:34:14 +0000 (+0200)
Subject: Math::BigFloat - fix bpi() and A [PATCH]
X-Git-Tag: perl-5.9.5~76
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/36ec1dfebf170dd9e8ba96cebf1fae69464caac4

Math::BigFloat - fix bpi() and A [PATCH]
Message-Id: <200706271834.14904@bloodgate.com>

p4raw-id: //depot/perl@31486
---

diff --git a/MANIFEST b/MANIFEST
index cdc9a2f..c623746 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2022,6 +2022,7 @@ lib/Math/BigInt/t/alias.inc	Support for BigInt tests
 lib/Math/BigInt/t/bare_mbf.t	Test MBF under Math::BigInt::BareCalc
 lib/Math/BigInt/t/bare_mbi.t	Test MBI under Math::BigInt::BareCalc
 lib/Math/BigInt/t/bare_mif.t	Rounding tests under BareCalc
+lib/Math/BigInt/t/big_pi_e.t	test bpi() and bexp()
 lib/Math/BigInt/t/bigfltpm.inc	Shared tests for bigfltpm.t and sub_mbf.t
 lib/Math/BigInt/t/bigfltpm.t	See if BigFloat.pm works
 lib/Math/BigInt/t/bigintc.t	See if BigInt/Calc.pm works
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 7fb9863..e97ef92 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -2588,6 +2588,7 @@ sub bpi
     $n = undef if $n eq 'Math::BigFloat';
     }
   $self = ref($self) if ref($self);
+  my $fallback = defined $n ? 0 : 1;
   $n = 40 if !defined $n || $n < 1;
 
   # after 黃見利 (Hwang Chien-Lih) (1997)
@@ -2624,11 +2625,13 @@ sub bpi
   $v->bdiv($v_d, $n);
   $w->bdiv($w_d, $n);
 
-  delete $x->{a}; delete $y->{a}; delete $z->{a};
-  delete $u->{a}; delete $v->{a}; delete $w->{a};
+  delete $x->{_a}; delete $y->{_a}; delete $z->{_a};
+  delete $u->{_a}; delete $v->{_a}; delete $w->{_a};
   $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w);
 
-  $x->round($n-4);
+  $x->bround($n-4);
+  delete $x->{_a} if $fallback == 1;
+  $x;
   }
 
 sub bcos
@@ -2683,7 +2686,7 @@ sub bcos
   my $x2 = $over->copy();               # X ^ 2; difference between terms
   my $sign = 1;                         # start with -=
   my $below = $self->new(2); my $factorial = $self->new(3);
-  $x->bone(); delete $x->{a}; delete $x->{p};
+  $x->bone(); delete $x->{_a}; delete $x->{_p};
 
   my $limit = $self->new("1E-". ($scale-1));
   #my $steps = 0;
@@ -2782,7 +2785,7 @@ sub bsin
   $over->bmul($x);			# X ^ 3 as starting value
   my $sign = 1;				# start with -=
   my $below = $self->new(6); my $factorial = $self->new(4);
-  delete $x->{a}; delete $x->{p};
+  delete $x->{_a}; delete $x->{_p};
 
   my $limit = $self->new("1E-". ($scale-1));
   #my $steps = 0;
@@ -3065,7 +3068,7 @@ sub batan
   my $sign = 1;				# start with -=
   my $below = $self->new(3);
   my $two = $self->new(2);
-  delete $x->{a}; delete $x->{p};
+  delete $x->{_a}; delete $x->{_p};
 
   my $limit = $self->new("1E-". ($scale-1));
   #my $steps = 0;
diff --git a/lib/Math/BigInt/t/big_pi_e.t b/lib/Math/BigInt/t/big_pi_e.t
new file mode 100644
index 0000000..9ecae00
--- /dev/null
+++ b/lib/Math/BigInt/t/big_pi_e.t
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -w
+
+# Test bpi() and bexp()
+
+use Test::More;
+use strict;
+
+BEGIN
+  {
+  $| = 1;
+  # to locate the testing files
+  my $location = $0; $location =~ s/big_pi_e.t//i;
+  if ($ENV{PERL_CORE})
+    {
+    # testing with the core distribution
+    @INC = qw(../lib);
+    }
+  unshift @INC, '../lib';
+  if (-d 't')
+    {
+    chdir 't';
+    require File::Spec;
+    unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+    }
+  else
+    {
+    unshift @INC, $location;
+    }
+  print "# INC = @INC\n";
+
+  plan tests => 8;
+  }
+
+use Math::BigFloat;
+
+#############################################################################
+
+my $pi = Math::BigFloat::bpi();
+
+ok (!exists $pi->{_a}, 'A not set');
+ok (!exists $pi->{_p}, 'P not set');
+
+$pi = Math::BigFloat->bpi();
+
+ok (!exists $pi->{_a}, 'A not set');
+ok (!exists $pi->{_p}, 'P not set');
+
+$pi = Math::BigFloat->bpi(10);
+
+is ($pi->{_a}, 10, 'A set');
+is ($pi->{_p}, undef, 'P not set');
+
+#############################################################################
+my $e = Math::BigFloat->new(1)->bexp();
+
+ok (!exists $e->{_a}, 'A not set');
+ok (!exists $e->{_p}, 'P not set');
+
+