xref: /openbsd/gnu/usr.bin/perl/cpan/Math-BigInt/t/round.t (revision 771fbea0) 
1#!/usr/bin/perl
2
3# test rounding with non-integer A and P parameters
4
5use strict;
6use warnings;
7
8use Test::More tests => 95;
9
10use Math::BigFloat;
11
12my $mbf = 'Math::BigFloat';
13#my $mbi = 'Math::BigInt';
14
15my $x = $mbf->new('123456.123456');
16
17# unary ops with A
18_do_a($x, 'round', 3, '123000');
19_do_a($x, 'bfround', 3, '123500');
20_do_a($x, 'bfround', 2, '123460');
21_do_a($x, 'bfround', -2, '123456.12');
22_do_a($x, 'bfround', -3, '123456.123');
23
24_do_a($x, 'bround', 4, '123500');
25_do_a($x, 'bround', 3, '123000');
26_do_a($x, 'bround', 2, '120000');
27
28_do_a($x, 'bsqrt', 4, '351.4');
29_do_a($x, 'bsqrt', 3, '351');
30_do_a($x, 'bsqrt', 2, '350');
31
32# setting P
33_do_p($x, 'bsqrt', 2, '350');
34_do_p($x, 'bsqrt', -2, '351.36');
35
36# binary ops
37_do_2_a($x, 'bdiv', 2, 6, '61728.1');
38_do_2_a($x, 'bdiv', 2, 4, '61730');
39_do_2_a($x, 'bdiv', 2, 3, '61700');
40
41_do_2_p($x, 'bdiv', 2, -6, '61728.061728');
42_do_2_p($x, 'bdiv', 2, -4, '61728.0617');
43_do_2_p($x, 'bdiv', 2, -3, '61728.062');
44
45# all tests done
46
47#############################################################################
48
49sub _do_a {
50    my ($x, $method, $A, $result) = @_;
51
52    is($x->copy->$method($A), $result, "$method($A)");
53    is($x->copy->$method($A.'.1'), $result, "$method(${A}.1)");
54    is($x->copy->$method($A.'.5'), $result, "$method(${A}.5)");
55    is($x->copy->$method($A.'.6'), $result, "$method(${A}.6)");
56    is($x->copy->$method($A.'.9'), $result, "$method(${A}.9)");
57}
58
59sub _do_p {
60    my ($x, $method, $P, $result) = @_;
61
62    is($x->copy->$method(undef, $P), $result, "$method(undef, $P)");
63    is($x->copy->$method(undef, $P.'.1'), $result, "$method(undef, ${P}.1)");
64    is($x->copy->$method(undef, $P.'.5'), $result, "$method(undef.${P}.5)");
65    is($x->copy->$method(undef, $P.'.6'), $result, "$method(undef, ${P}.6)");
66    is($x->copy->$method(undef, $P.'.9'), $result, "$method(undef, ${P}.9)");
67}
68
69sub _do_2_a {
70    my ($x, $method, $y, $A, $result) = @_;
71
72    my $cy = $mbf->new($y);
73
74    is($x->copy->$method($cy, $A), $result, "$method($cy, $A)");
75    is($x->copy->$method($cy, $A.'.1'), $result, "$method($cy, ${A}.1)");
76    is($x->copy->$method($cy, $A.'.5'), $result, "$method($cy, ${A}.5)");
77    is($x->copy->$method($cy, $A.'.6'), $result, "$method($cy, ${A}.6)");
78    is($x->copy->$method($cy, $A.'.9'), $result, "$method($cy, ${A}.9)");
79}
80
81sub _do_2_p {
82    my ($x, $method, $y, $P, $result) = @_;
83
84    my $cy = $mbf->new($y);
85
86    is($x->copy->$method($cy, undef, $P), $result,
87       "$method(undef, $P)");
88    is($x->copy->$method($cy, undef, $P.'.1'), $result,
89       "$method($cy, undef, ${P}.1)");
90    is($x->copy->$method($cy, undef, $P.'.5'), $result,
91       "$method($cy, undef, ${P}.5)");
92    is($x->copy->$method($cy, undef, $P.'.6'), $result,
93       "$method($cy, undef, ${P}.6)");
94    is($x->copy->$method($cy, undef, $P.'.9'), $result,
95       "$method($cy, undef, ${P}.9)");
96}
97