Commit | Line | Data |
---|---|---|
184f15d5 JH |
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; | |
9b924220 | 9 | use vars qw($VERSION @ISA |
184f15d5 JH |
10 | $accuracy $precision $round_mode $div_scale); |
11 | ||
9b924220 RGS |
12 | @ISA = qw(Math::BigRat Exporter); |
13 | $VERSION = 0.04; | |
184f15d5 JH |
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 | ||
9b924220 RGS |
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 | ||
184f15d5 JH |
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 | ||
9b924220 | 90 | # print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n"; |
184f15d5 JH |
91 | return $s.$x->{_n} if $x->{_d}->is_one(); |
92 | my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); | |
9b924220 RGS |
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(); | |
184f15d5 JH |
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 | ||
184f15d5 JH |
118 | my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); |
119 | return $s.$output->bsstr(); | |
120 | } | |
121 | ||
122 | 1; |