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);

unless(Math::MPFR::_MPFR_WANT_DECIMAL_FLOATS()) {
  print "1..1\n";
  warn "\n Skipping all tests - Math::MPFR not built with MPFR_WANT_DECIMAL_FLOATS defined\n";
  print "ok 1\n";
  exit 0;
}

my $t = 3;
print "1..$t\n";

my $why;
my $keep_printing = 1;

eval {require Math::Decimal64; Math::Decimal64->import (qw(:all));};
if($@) {$why = "Couldn't load Math::Decimal64\n"}
else {$why = "Math::MPFR not built for _Decimal64\n"
        unless Math::MPFR::_MPFR_WANT_DECIMAL_FLOATS()}

eval {require Math::LongDouble; Math::LongDouble->import (qw(:all));};
if($@) {$why .= "Couldn't load Math::LongDouble\n"}

unless($why) {

  my $d64_1 = Math::Decimal64->new(0);
  my $d64_2 = Math::Decimal64->new(0);
  my $ld    = ZeroLD(1);

  my $ok = 1;

  my $round = 0;# MPFR_RNDN

  my $mant_dig = Math::MPFR::_LDBL_MANT_DIG(); # expected to be either 64 or 106
  Rmpfr_set_default_prec($mant_dig);

  # If $mant_dig == 106, I assume the long double is "double-double" - which doesn't
  # accommodate the full exponent range of the Decimal64 type.
  my $rand_limit = $mant_dig == 106 ? 292 : 399;

  for my $it (1..100000) {
    my $digits = 1 + int(rand(16)); # Don't exceed max precision for this test.
    #Rmpfr_set_default_prec(53 + int(rand(100)));
    my $man_sign = $it % 2 ? '-' : '';
    my $exp_sign = $it % 3 ? 1 : -1;
    my $man = $man_sign . get_man($digits);
    my $exp = int(rand($rand_limit)) * $exp_sign;
    #next if $exp + $digits > 385;
    my $fr_arg = $man . '@' . $exp;

    my $d64_check = Math::Decimal64->new($man, $exp);

    my $fr = Math::MPFR->new($fr_arg, 10);

    Rmpfr_get_DECIMAL64($d64_1, $fr, $round);
    Rmpfr_get_LD($ld, $fr, $round);
    LDtoD64($d64_2, $ld);

    unless($d64_2 == $d64_1) {
      if($keep_printing < 6) {
        warn "$digits $exp\n$fr_arg\n $fr\n";
        warn "\$d64_check: $d64_check\n\$d64_1: $d64_1\n\$d64_2: $d64_2\n\$ld: $ld\n\n";
        $ok = 0;
      }
    $keep_printing++;
    }
  }


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

  $ok = 1;

  for(3 .. 70) {
    my $eps = Math::Decimal64->new(1, -398);
    my $eps_ret = NVtoD64(2.5);
    my $eps_fr = Rmpfr_init2($_);
    Rmpfr_set_DECIMAL64($eps_fr, $eps, MPFR_RNDN);
    Rmpfr_get_DECIMAL64($eps_ret, $eps_fr, MPFR_RNDN);
    unless($eps_ret == $eps) {
      warn "\nMPFR precision: ", Rmpfr_get_prec($eps_fr), "\n";
      warn "\$eps: $eps\n\$eps_ret: $eps_ret\n";
      $ok = 0;
    }
  }

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

  Rmpfr_set_default_prec($mant_dig);
  my $root = Math::MPFR->new(2.0);
  Rmpfr_sqrt($root, $root, MPFR_RNDN);
  my $ld_root = sqrt(Math::LongDouble->new(2.0));
  Rmpfr_get_LD($ld, $root, MPFR_RNDN);

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

}
else {
 warn "\nSkipping all tests\n";
 warn $why;
 for (1 .. $t) {print "ok $_\n"}
}


sub get_man {
  my $ret = '';
  for(1 .. $_[0]) {$ret .= int(rand(10))}
  return $ret;
}