The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Test the functions that became available with MPFR-2.1.0.
use strict;
use warnings;
use Math::MPFR qw(:mpfr);

print "1..21\n";

print  "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n";
print  "# Using mpfr library version ", MPFR_VERSION_STRING, "\n";
print  "# Using gmp library version ", Math::MPFR::gmp_v(), "\n";

Rmpfr_set_default_prec(300);
my $rnd = 0;

my $double = 1234567.0987;
my $mpfr_nan = Rmpfr_init();
my $mpfr1 = Rmpfr_init();
my $mpfr2 = Rmpfr_init();
my $v;

my($have_mpz, $have_mpf, $have_mpq, $have_gmp) = (0, 0, 0, 0);

eval{require Math::GMPz};
if(!$@) {$have_mpz = 1}

eval{require Math::GMPf};
if(!$@) {$have_mpf = 1}

eval{require Math::GMPq};
if(!$@) {$have_mpq = 1}

eval{require Math::GMP};
if(!$@) {$have_gmp = 1}

Rmpfr_set_d($mpfr1, $double, $rnd);

if($have_mpz) {
  my $ok = '';
  my $z = Math::GMPz::Rmpz_init_set_ui(123456);
  my $cmp = Rmpfr_cmp_z($mpfr_nan, $z);
  if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'}
  Rmpfr_clear_erangeflag();
  if(!Rmpfr_erangeflag_p()) {$ok .= 'b'}
  if(Rmpfr_cmp_z($mpfr1, $z) > 0) {$ok .= 'c'}
  my $ret = Rmpfr_get_z($z, $mpfr1, $rnd);
  if(MPFR_VERSION_MAJOR >= 3) {
    if(defined($ret)) {$ok .= 'D'}
  }
  else {
    if(!defined($ret)) {$ok .= 'D'}
  }
  Rmpfr_trunc($mpfr1, $mpfr1);
  if(!Rmpfr_cmp_z($mpfr1, $z)) {$ok .= 'd'}
  Rmpfr_set_d($mpfr1, $double, $rnd);
  if($ok eq 'abcDd') {print "ok 1\n"}
  else {print "not ok 1 $ok\n"}
}
else {
  warn "Skipping test 1 - no Math::GMPz\n";
  print "ok 1\n";
}

if($have_mpq) {
  my $ok = '';
  my $q = Math::GMPq::Rmpq_init();
  Math::GMPq::Rmpq_set_ui($q, 11, 17);
  my $cmp = Rmpfr_cmp_q($mpfr_nan, $q);
  if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'}
  Rmpfr_clear_erangeflag();
  if(!Rmpfr_erangeflag_p()) {$ok .= 'b'}
  if(Rmpfr_cmp_q($mpfr1, $q) > 0) {$ok .= 'c'}
  if($ok eq 'abc') {print "ok 2\n"}
  else {print "not ok 2 $ok\n"}
}
else {
  warn "Skipping test 2 - no Math::GMPq\n";
  print "ok 2\n";
}

if($have_mpf) {
  my $ok = '';
  my $f = Math::GMPf::Rmpf_init_set_d(123456.12);
  my $cmp = Rmpfr_cmp_f($mpfr_nan, $f);
  if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'}
  Rmpfr_clear_erangeflag();
  if(!Rmpfr_erangeflag_p()) {$ok .= 'b'}
  if(Rmpfr_cmp_f($mpfr1, $f) > 0) {$ok .= 'c'}
  if($ok eq 'abc') {print "ok 3\n"}
  else {print "not ok 3 $ok\n"}
}
else {
  warn "Skipping test 3 - no Math::GMPf\n";
  print "ok 3\n";
}

if($have_gmp) {
  my $ok = '';
  my $z = Math::GMP->new(123456);
  my $cmp = Rmpfr_cmp_z($mpfr_nan, $z);
  if(Rmpfr_erangeflag_p() && !$cmp) {$ok .= 'a'}
  Rmpfr_clear_erangeflag();
  if(!Rmpfr_erangeflag_p()) {$ok .= 'b'}
  if(Rmpfr_cmp_z($mpfr1, $z) > 0) {$ok .= 'c'}
  Rmpfr_get_z($z, $mpfr1, $rnd);
  Rmpfr_trunc($mpfr1, $mpfr1);
  if(!Rmpfr_cmp_z($mpfr1, $z)) {$ok .= 'd'}
  Rmpfr_set_d($mpfr1, $double, $rnd);
  if($ok eq 'abcd') {print "ok 4\n"}
  else {print "not ok 4 $ok\n"}
}
else {
  warn "Skipping test 4 - no Math::GMP\n";
  print "ok 4\n";
}

Rmpfr_set_ui_2exp($mpfr2, 5, 3, $rnd);
if($mpfr2 == 40) {print "ok 5\n"}
else {print "not ok 5\n"}

Rmpfr_set_si_2exp($mpfr2, 5, 3, $rnd);
if($mpfr2 == 40) {print "ok 6\n"}
else {print "not ok 6\n"}

Rmpfr_set_si_2exp($mpfr2, 8, -3, $rnd);
if($mpfr2 == 1) {print "ok 7\n"}
else {print "not ok 7\n"}

Rmpfr_sub_si($mpfr2, $mpfr2, -11, $rnd);
if($mpfr2 == 12) {print "ok 8\n"}
else {print "not ok 8\n"}

Rmpfr_si_sub($mpfr2, -11, $mpfr2, $rnd);
if($mpfr2 == -23) {print "ok 9\n"}
else {print "not ok 9\n"}

Rmpfr_mul_si($mpfr2, $mpfr2, -11, $rnd);
if($mpfr2 == 253) {print "ok 10\n"}
else {print "not ok 10\n"}

Rmpfr_div_si($mpfr2, $mpfr2, -11, $rnd);
if($mpfr2 == -23) {print "ok 11\n"}
else {print "not ok 11\n"}

$mpfr2++;

Rmpfr_si_div($mpfr2, -11, $mpfr2, $rnd);
if($mpfr2 == 0.5) {print "ok 12\n"}
else {print "not ok 12\n"}

Rmpfr_mul($mpfr1, $mpfr2, $mpfr2, $rnd);
Rmpfr_sqr($mpfr2, $mpfr2, $rnd);
if($mpfr1 == $mpfr2) {print "ok 13\n"}
else {print "not ok 13\n"}

Rmpfr_const_pi($mpfr1, $rnd);
if(!Rmpfr_zero_p($mpfr1)) {print "ok 14\n"}
else {print "not ok 14\n"}

eval{Rmpfr_free_cache();};
if(!$@) {print "ok 15\n"}
else {print "not ok 15: $@\n"}

eval{$v = Rmpfr_get_version();};
if(!$@ && $v) {print "ok 16\n"}
else {print "not ok 16: $@\n"}

if((Rmpfr_get_emin_min() <= Rmpfr_get_emin_max()) &&
   (Rmpfr_get_emax_min() <= Rmpfr_get_emax_max())) {print "ok 17\n"}
else {print "not ok 17\n"}

Rmpfr_set_d($mpfr1, $double, $rnd);

Rmpfr_rint_ceil($mpfr2, $mpfr1, $rnd);
if($mpfr2 == 1234568) {print "ok 18\n"}
else {print "not ok 18\n"}

Rmpfr_rint_floor($mpfr2, $mpfr1, $rnd);
if($mpfr2 == 1234567) {print "ok 19\n"}
else {print "not ok 19\n"}

Rmpfr_rint_round($mpfr2, $mpfr1, $rnd);
if($mpfr2 == 1234567) {print "ok 20\n"}
else {print "not ok 20\n"}

Rmpfr_rint_trunc($mpfr2, $mpfr1, $rnd);
if($mpfr2 == 1234567) {print "ok 21\n"}
else {print "not ok 21\n"}