1#!/usr/bin/perl -w 2 3# test rounding with non-integer A and P parameters 4 5use strict; 6use Test::More; 7 8BEGIN 9 { 10 $| = 1; 11 # to locate the testing files 12 my $location = $0; $location =~ s/round.t//i; 13 if ($ENV{PERL_CORE}) 14 { 15 # testing with the core distribution 16 @INC = qw(../t/lib); 17 } 18 unshift @INC, qw(../lib); 19 if (-d 't') 20 { 21 chdir 't'; 22 require File::Spec; 23 unshift @INC, File::Spec->catdir(File::Spec->updir, $location); 24 } 25 else 26 { 27 unshift @INC, $location; 28 } 29 print "# INC = @INC\n"; 30 31 plan tests => 95; 32 } 33 34use Math::BigFloat; 35 36my $cf = 'Math::BigFloat'; 37my $ci = 'Math::BigInt'; 38 39my $x = $cf->new('123456.123456'); 40 41# unary ops with A 42_do_a($x, 'round', 3, '123000'); 43_do_a($x, 'bfround', 3, '123500'); 44_do_a($x, 'bfround', 2, '123460'); 45_do_a($x, 'bfround', -2, '123456.12'); 46_do_a($x, 'bfround', -3, '123456.123'); 47 48_do_a($x, 'bround', 4, '123500'); 49_do_a($x, 'bround', 3, '123000'); 50_do_a($x, 'bround', 2, '120000'); 51 52_do_a($x, 'bsqrt', 4, '351.4'); 53_do_a($x, 'bsqrt', 3, '351'); 54_do_a($x, 'bsqrt', 2, '350'); 55 56# setting P 57_do_p($x, 'bsqrt', 2, '350'); 58_do_p($x, 'bsqrt', -2, '351.36'); 59 60# binary ops 61_do_2_a($x, 'bdiv', 2, 6, '61728.1'); 62_do_2_a($x, 'bdiv', 2, 4, '61730'); 63_do_2_a($x, 'bdiv', 2, 3, '61700'); 64 65_do_2_p($x, 'bdiv', 2, -6, '61728.061728'); 66_do_2_p($x, 'bdiv', 2, -4, '61728.0617'); 67_do_2_p($x, 'bdiv', 2, -3, '61728.062'); 68 69# all tests done 70 71############################################################################# 72 73sub _do_a 74 { 75 my ($x, $method, $A, $result) = @_; 76 77 is ($x->copy->$method($A), $result, "$method($A)"); 78 is ($x->copy->$method($A.'.1'), $result, "$method(${A}.1)"); 79 is ($x->copy->$method($A.'.5'), $result, "$method(${A}.5)"); 80 is ($x->copy->$method($A.'.6'), $result, "$method(${A}.6)"); 81 is ($x->copy->$method($A.'.9'), $result, "$method(${A}.9)"); 82 } 83 84sub _do_p 85 { 86 my ($x, $method, $P, $result) = @_; 87 88 is ($x->copy->$method(undef,$P), $result, "$method(undef,$P)"); 89 is ($x->copy->$method(undef,$P.'.1'), $result, "$method(undef,${P}.1)"); 90 is ($x->copy->$method(undef,$P.'.5'), $result, "$method(undef.${P}.5)"); 91 is ($x->copy->$method(undef,$P.'.6'), $result, "$method(undef,${P}.6)"); 92 is ($x->copy->$method(undef,$P.'.9'), $result, "$method(undef,${P}.9)"); 93 } 94 95sub _do_2_a 96 { 97 my ($x, $method, $y, $A, $result) = @_; 98 99 my $cy = $cf->new($y); 100 101 is ($x->copy->$method($cy,$A), $result, "$method($cy,$A)"); 102 is ($x->copy->$method($cy,$A.'.1'), $result, "$method($cy,${A}.1)"); 103 is ($x->copy->$method($cy,$A.'.5'), $result, "$method($cy,${A}.5)"); 104 is ($x->copy->$method($cy,$A.'.6'), $result, "$method($cy,${A}.6)"); 105 is ($x->copy->$method($cy,$A.'.9'), $result, "$method($cy,${A}.9)"); 106 } 107 108sub _do_2_p 109 { 110 my ($x, $method, $y, $P, $result) = @_; 111 112 my $cy = $cf->new($y); 113 114 is ($x->copy->$method($cy,undef,$P), $result, "$method(undef,$P)"); 115 is ($x->copy->$method($cy,undef,$P.'.1'), $result, "$method($cy,undef,${P}.1)"); 116 is ($x->copy->$method($cy,undef,$P.'.5'), $result, "$method($cy,undef.${P}.5)"); 117 is ($x->copy->$method($cy,undef,$P.'.6'), $result, "$method($cy,undef,${P}.6)"); 118 is ($x->copy->$method($cy,undef,$P.'.9'), $result, "$method($cy,undef,${P}.9)"); 119 } 120 121