The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use warnings;
use strict;
use Math::MPFR qw(:mpfr);
#use Devel::Peek;

print "1..3\n";

my ($exp, $ret);
my $rop   = Math::MPFR->new();
my $op1   = Math::MPFR->new(64.75);
my $op2   = Math::MPFR->new(0.25);
my $nan   = Math::MPFR->new();
my $zero  = Math::MPFR->new(0);
my $unity = Math::MPFR->new(1);
my $inf   = $unity / $zero;
my $ninf  = -($inf);
my $nzero = $zero * -1;
my $ok = '';

if((MPFR_VERSION_MAJOR == 3 && MPFR_VERSION_MINOR >= 1) || MPFR_VERSION_MAJOR > 3) {
  $ret = Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN);
  if($ret == 0 && $exp == 7 && $rop == 0.505859375) {$ok .= 'a'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $op2, GMP_RNDN);
  if($ret == 0 && $exp == -1 && $rop == 0.5) {$ok .= 'b'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, -$op1, GMP_RNDN);
  if($ret == 0 && $exp == 7 && $rop == -0.505859375) {$ok .= 'c'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, -$op2, GMP_RNDN);
  if($ret == 0 && $exp == -1 && $rop == -0.5) {$ok .= 'd'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $zero, GMP_RNDN);
  if($ret == 0 && $exp == 0 && $rop == 0 && Rmpfr_sgn($rop) == 0 && !Rmpfr_signbit($rop)) {$ok .= 'e'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $nzero, GMP_RNDN);
  if($ret == 0 && $exp == 0 && $rop == 0 && !Rmpfr_sgn($rop) && Rmpfr_signbit($rop)) {$ok .= 'f'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $nan, GMP_RNDN);
  if($ret == 0 && Rmpfr_nan_p($rop)) {$ok .= 'g'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $inf, GMP_RNDN);
  if($ret == 0 && Rmpfr_inf_p($rop) && !Rmpfr_signbit($rop)) {$ok .= 'h'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  $ret = Rmpfr_frexp($exp, $rop, $ninf, GMP_RNDN);
  if($ret == 0 && Rmpfr_inf_p($rop) && Rmpfr_signbit($rop)) {$ok .= 'i'}
  #print "$ret $exp $rop\n", $rop * (2 ** $exp), "\n\n";

  if($ok eq 'abcdefghi') {print "ok 1\n"}
  else {
    warn "1: \$ok: $ok\n";
    print "not ok 1\n";
  }
}
else {
  eval{Rmpfr_frexp($exp, $rop, $op1, GMP_RNDN);};
  if($@ =~ /Rmpfr_frexp not implemented/) {print "ok 1\n"}
  else {
    warn "\$\@: $@";
    print "not ok 1\n";
  }
}

$ok = '';

$ret = Rmpfr_get_d_2exp($exp, $op1, GMP_RNDN);
if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $op2, GMP_RNDN);
if($exp == -1 && $ret == 0.5) {$ok .= 'b'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, -$op1, GMP_RNDN);
if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, -$op2, GMP_RNDN);
if($exp == -1 && $ret == -0.5) {$ok .= 'd'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $zero, GMP_RNDN);
if($exp == 0 && is_pzero($ret)) {$ok .= 'e'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $nzero, GMP_RNDN);
if($exp == 0 && is_nzero($ret)) {$ok .= 'f'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $nan, GMP_RNDN);
if(is_nan($ret)) {$ok .= 'g'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $inf, GMP_RNDN);
if(is_pinf($ret)) {$ok .= 'h'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

$ret = Rmpfr_get_d_2exp($exp, $ninf, GMP_RNDN);
if(is_ninf($ret)) {$ok .= 'i'}
#print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

if($ok eq 'abcdefghi') {print "ok 2\n"}
else {
  warn "2: \$ok: $ok\n";
  print "not ok 2\n";
}

$ok = '';

if(Math::MPFR::_has_longdouble()) {
  $ret = Rmpfr_get_ld_2exp($exp, $op1, GMP_RNDN);
  if($exp == 7 && $ret == 0.505859375) {$ok .= 'a'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $op2, GMP_RNDN);
  if($exp == -1 && $ret == 0.5) {$ok .= 'b'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, -$op1, GMP_RNDN);
  if($exp == 7 && $ret == -0.505859375) {$ok .= 'c'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, -$op2, GMP_RNDN);
  if($exp == -1 && $ret == -0.5) {$ok .= 'd'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $zero, GMP_RNDN);
  if($exp == 0 && is_pzero($ret)) {$ok .= 'e'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $nzero, GMP_RNDN);
  if($exp == 0 && is_nzero($ret)) {$ok .= 'f'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $nan, GMP_RNDN);
  if(is_nan($ret)) {$ok .= 'g'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $inf, GMP_RNDN);
  if(is_pinf($ret)) {$ok .= 'h'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  $ret = Rmpfr_get_ld_2exp($exp, $ninf, GMP_RNDN);
  if(is_ninf($ret)) {$ok .= 'i'}
  #print "$ret $exp\n", $ret * (2 ** $exp), "\n\n";

  if($ok eq 'abcdefghi') {print "ok 3\n"}
  else {
    warn "3: \$ok: $ok\n";
    print "not ok 3\n";
  }
}
else {
  warn "Skipping test 3 - no long double support\n";
  print "ok 3\n";
}

sub is_nan {
    return Rmpfr_nan_p(Math::MPFR->new($_[0]));
}

sub is_pinf {
    my $x = Math::MPFR->new($_[0]);
    if(Rmpfr_inf_p($x) && !Rmpfr_signbit($x)) {return 1}
    return 0;
}

sub is_ninf {
    my $x = Math::MPFR->new($_[0]);
    if(Rmpfr_inf_p($x) && Rmpfr_signbit($x)) {return 1}
    return 0;
}

sub is_pzero {
    my $x = Math::MPFR->new($_[0]);
    if(Rmpfr_zero_p($x) && !Rmpfr_signbit($x)) {return 1}
    return 0;
}

sub is_nzero {
    my $x = Math::MPFR->new($_[0]);
    if(Rmpfr_zero_p($x) && Rmpfr_signbit($x)) {return 1}
    return 0;
}