xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/lib/Math/BigRat/Test.pm (revision 0:68f95e015346)
1package Math::BigRat::Test;
2
3require 5.005_02;
4use strict;
5
6use Exporter;
7use Math::BigRat;
8use Math::BigFloat;
9use vars qw($VERSION @ISA
10            $accuracy $precision $round_mode $div_scale);
11
12@ISA = qw(Math::BigRat Exporter);
13$VERSION = 0.04;
14
15use overload; 		# inherit overload from BigRat
16
17# Globals
18$accuracy = $precision = undef;
19$round_mode = 'even';
20$div_scale = 40;
21
22my $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
39BEGIN
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
52sub 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
64sub 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
75sub 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
98sub numify
99  {
100  $_[0]->bsstr();
101  }
102
103sub 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
1221;
123