cpan/Math-BigInt/t/round.t

   1 #!/usr/bin/perl -w
   2
   3 # test rounding with non-integer A and P parameters
   4
   5 use strict;
   6 use Test::More;
   7
   8 BEGIN
   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
  34 use Math::BigFloat;
  35
  36 my $cf = 'Math::BigFloat';
  37 my $ci = 'Math::BigInt';
  38
  39 my $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
  73 sub _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
  84 sub _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
  95 sub _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
 108 sub _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