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