The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# This file so named because it tests the fixing of a bug with -0 and mpfr_fits_u*_p().
# The bug was present in mpfr up to (and including) version 3.1.2.

use warnings;
use strict;
use Math::MPFR qw(:mpfr);

print "1..8\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(150);

my($ok, $count) = (0, 24);

my @vals = (
            Math::MPFR->new(-0.99999), Math::MPFR->new(-0.50001),
            Math::MPFR->new(-0.5), Math::MPFR->new(-0.4999999),
            Math::MPFR->new(-0.000001), Math::MPFR->new(0.0),
           );

$vals[5] *= -1.0;

my @rnds = (0 .. 3);

unless(3 > MPFR_VERSION_MAJOR) {
  $count += 6;
  push @rnds, 4;
}

for my $r(@rnds) {
  for my $v(@vals) {

    if($r == MPFR_RNDN) {
      if($v >= -0.5) {
        if(Rmpfr_fits_ushort_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_ushort_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"}
      }
    }
    elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) {
      if(Rmpfr_fits_ushort_p($v, $r)) {$ok++}
      else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"}
    }
    else {
      if($v == 0) {
        if(Rmpfr_fits_ushort_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_ushort_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ushort_p($v, $r), "\n"}
      }
    }
  }
}

if($ok == $count) {print "ok 1\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 1\n";
}

$ok = 0;

for my $r(@rnds) {
  for my $v(@vals) {

    if($r == MPFR_RNDN) {
      if($v >= -0.5) {
        if(Rmpfr_fits_uint_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_uint_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"}
      }
    }
    elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) {
      if(Rmpfr_fits_uint_p($v, $r)) {$ok++}
      else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"}
    }
    else {
      if($v == 0) {
        if(Rmpfr_fits_uint_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_uint_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uint_p($v, $r), "\n"}
      }
    }
  }
}

if($ok == $count) {print "ok 2\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 2\n";
}

$ok = 0;

for my $r(@rnds) {
  for my $v(@vals) {

    if($r == MPFR_RNDN) {
      if($v >= -0.5) {
        if(Rmpfr_fits_ulong_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_ulong_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"}
      }
    }
    elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) {
      if(Rmpfr_fits_ulong_p($v, $r)) {$ok++}
      else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"}
    }
    else {
      if($v == 0) {
        if(Rmpfr_fits_ulong_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_ulong_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_ulong_p($v, $r), "\n"}
      }
    }
  }
}

if($ok == $count) {print "ok 3\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 3\n";
}

$ok = 0;

for my $r(@rnds) {
  for my $v(@vals) {

    if($r == MPFR_RNDN) {
      if($v >= -0.5) {
        if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_uintmax_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"}
      }
    }
    elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) {
      if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++}
      else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"}
    }
    else {
      if($v == 0) {
        if(Rmpfr_fits_uintmax_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_uintmax_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_uintmax_p($v, $r), "\n"}
      }
    }
  }
}

if($ok == $count) {print "ok 4\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 4\n";
}

$ok = 0;

for my $r(@rnds) {
  for my $v(@vals) {

    if($r == MPFR_RNDN) {
      if($v >= -0.5) {
        if(Rmpfr_fits_UV_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_UV_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"}
      }
    }
    elsif($r == MPFR_RNDZ || $r == MPFR_RNDU) {
      if(Rmpfr_fits_UV_p($v, $r)) {$ok++}
      else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"}
    }
    else {
      if($v == 0) {
        if(Rmpfr_fits_UV_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"}
      }
      else {
        if(!Rmpfr_fits_UV_p($v, $r)) {$ok++}
        else { warn "$r : $v : ", Rmpfr_fits_UV_p($v, $r), "\n"}
      }
    }
  }
}

if($ok == $count) {print "ok 5\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 5\n";
}

$ok = 0;

for my $r(@rnds) {
  for my $v(@vals) {
    if(Rmpfr_fits_sshort_p($v, $r)) {$ok++}
    else { warn "sshort: $r : $v : ", Rmpfr_fits_sshort_p($v, $r), "\n"}

    if(Rmpfr_fits_sint_p($v, $r)) {$ok++}
    else { warn "sint: $r : $v : ", Rmpfr_fits_sint_p($v, $r), "\n"}

    if(Rmpfr_fits_slong_p($v, $r)) {$ok++}
    else { warn "slong: $r : $v : ", Rmpfr_fits_slong_p($v, $r), "\n"}

    if(Rmpfr_fits_intmax_p($v, $r)) {$ok++}
    else { warn "intmax: $r : $v : ", Rmpfr_fits_intmax_p($v, $r), "\n"}

    if(Rmpfr_fits_IV_p($v, $r)) {$ok++}
    else { warn "IV: $r : $v : ", Rmpfr_fits_IV_p($v, $r), "\n"}
  }
}

if($ok == $count * 5) {print "ok 6\n"}
else {
  warn "\n\$ok: $ok\n\$count: $count\n";
  print "not ok 6\n";
}

my $fr1 = Math::MPFR->new(-1.0);
my $fr2 = Math::MPFR->new(0.6);
$ok = 1;

for my $r(@rnds) {
  if(Rmpfr_fits_ushort_p($fr1, $r)) {
    warn "ushort: $fr1: $r: ", Rmpfr_fits_ushort_p($fr1, $r), "\n";
    $ok = 0;
  }

  if(Rmpfr_fits_uint_p($fr1, $r)) {
    warn "uint: $fr1: $r: ", Rmpfr_fits_uint_p($fr1, $r), "\n";
    $ok = 0;
  }

  if(Rmpfr_fits_ulong_p($fr1, $r)) {
    warn "ulong: $fr1: $r: ", Rmpfr_fits_ulong_p($fr1, $r), "\n";
    $ok = 0;
  }

  if(Rmpfr_fits_uintmax_p($fr1, $r)) {
    warn "uintmax: $fr1: $r: ", Rmpfr_fits_uintmax_p($fr1, $r), "\n";
    $ok = 0;
  }

  if(Rmpfr_fits_UV_p($fr1, $r)) {
    warn "UV: $fr1: $r: ", Rmpfr_fits_UV_p($fr1, $r), "\n";
    $ok = 0;
  }
}

if($ok){print "ok 7\n"}
else {print "not ok 7\n"}

$ok = 1;

for my $r(@rnds) {
  if(!Rmpfr_fits_ushort_p($fr2, $r)) {
    warn "ushort: $fr2: $r: ", Rmpfr_fits_ushort_p($fr2, $r), "\n";
    $ok = 0;
  }

  if(!Rmpfr_fits_uint_p($fr2, $r)) {
    warn "uint: $fr2: $r: ", Rmpfr_fits_uint_p($fr2, $r), "\n";
    $ok = 0;
  }

  if(!Rmpfr_fits_ulong_p($fr2, $r)) {
    warn "ulong: $fr2: $r: ", Rmpfr_fits_ulong_p($fr2, $r), "\n";
    $ok = 0;
  }

  if(!Rmpfr_fits_uintmax_p($fr2, $r)) {
    warn "uintmax: $fr2: $r: ", Rmpfr_fits_uintmax_p($fr2, $r), "\n";
    $ok = 0;
  }

  if(!Rmpfr_fits_UV_p($fr2, $r)) {
    warn "UV: $fr2: $r: ", Rmpfr_fits_UV_p($fr2, $r), "\n";
    $ok = 0;
  }
}

if($ok){print "ok 8\n"}
else {print "not ok 8\n"}