ext/Math-BigRat/t/Math/BigRat/Test.pm

   1 package Math::BigRat::Test;
   2
   3 require 5.005_02;
   4 use strict;
   5
   6 use Exporter;
   7 use Math::BigRat;
   8 use Math::BigFloat;
   9 use vars qw($VERSION @ISA
  10             $accuracy $precision $round_mode $div_scale);
  11
  12 @ISA = qw(Math::BigRat Exporter);
  13 $VERSION = 0.04;
  14
  15 use overload;           # inherit overload from BigRat
  16
  17 # Globals
  18 $accuracy = $precision = undef;
  19 $round_mode = 'even';
  20 $div_scale = 40;
  21
  22 my $class = 'Math::BigRat::Test';
  23
  24 #ub new
  25 #{
  26 #        my $proto  = shift;
  27 #        my $class  = ref($proto) || $proto;
  28 #
  29 #        my $value       = shift;
  30 #       my $a = $accuracy; $a = $_[0] if defined $_[0];
  31 #       my $p = $precision; $p = $_[1] if defined $_[1];
  32 #        # Store the floating point value
  33 #        my $self = Math::BigFloat->new($value,$a,$p,$round_mode);
  34 #        bless $self, $class;
  35 #        $self->{'_custom'} = 1; # make sure this never goes away
  36 #        return $self;
  37 #}
  38
  39 BEGIN
  40   {
  41   *fstr = \&bstr;
  42   *fsstr = \&bsstr;
  43   *objectify = \&Math::BigInt::objectify;
  44   *AUTOLOAD = \&Math::BigRat::AUTOLOAD;
  45   no strict 'refs';
  46   foreach my $method ( qw/ div acmp floor ceil root sqrt log fac modpow modinv/)
  47     {
  48     *{'b' . $method} = \&{'Math::BigRat::b' . $method};
  49     }
  50   }
  51
  52 sub fround
  53   {
  54   my ($x,$a) = @_;
  55
  56   #print "$a $accuracy $precision $round_mode\n";
  57   Math::BigFloat->round_mode($round_mode);
  58   Math::BigFloat->accuracy($a || $accuracy);
  59   Math::BigFloat->precision(undef);
  60   my $y = Math::BigFloat->new($x->bsstr(),undef,undef);
  61   $class->new($y->fround($a));
  62   }
  63
  64 sub ffround
  65   {
  66   my ($x,$p) = @_;
  67
  68   Math::BigFloat->round_mode($round_mode);
  69   Math::BigFloat->accuracy(undef);
  70   Math::BigFloat->precision($p || $precision);
  71   my $y = Math::BigFloat->new($x->bsstr(),undef,undef);
  72   $class->new($y->ffround($p));
  73   }
  74
  75 sub bstr
  76   {
  77   # calculate a BigFloat compatible string output
  78   my ($x) = @_;
  79
  80   $x = $class->new($x) unless ref $x;
  81
  82   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
  83     {
  84     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
  85     return $s;
  86     }
  87
  88   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # +3 vs 3
  89
  90 #  print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n";
  91   return $s.$x->{_n} if $x->{_d}->is_one();
  92   my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d});
  93   local $Math::BigFloat::accuracy = $accuracy || $x->{_a};
  94   local $Math::BigFloat::precision = $precision || $x->{_p};
  95   $s.$output->bstr();
  96   }
  97
  98 sub numify
  99   {
 100   $_[0]->bsstr();
 101   }
 102
 103 sub bsstr
 104   {
 105   # calculate a BigFloat compatible string output
 106   my ($x) = @_;
 107
 108   $x = $class->new($x) unless ref $x;
 109
 110   if ($x->{sign} !~ /^[+-]$/)           # inf, NaN etc
 111     {
 112     my $s = $x->{sign}; $s =~ s/^\+//;  # +inf => inf
 113     return $s;
 114     }
 115
 116   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';     # +3 vs 3
 117
 118   my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d});
 119   return $s.$output->bsstr();
 120   }
 121
 122 1;