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


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

warn "\nbyteorder: ", $Config{byteorder}, "\n";

my $kind;

my %ldkind = (
 -1 => 'unknown',
  0 => 'double',
  1 => '"IEEE" 754 128-bit little endian',
  2 => '"IEEE" 754 128-bit big endian',
  3 => 'x86 80-bit little endian',
  4 => 'x86 80-bit big endian',
  5 => 'double-double 128-bit little endian',
  6 => 'double-double 128-bit big endian',
);

if(defined $Config{longdblkind}) {
  $kind = $Config{longdblkind};
  warn "longdblkind: $kind: $ldkind{$kind}\n";
}
else {
  warn "\$Config{longdblkind} not defined for this build of perl $]\n";
}

warn "HAVE_IEEE_754_LONG_DOUBLE defined is ", Math::MPFR::_have_IEEE_754_long_double(), "\n";
warn "HAVE_EXTENDED_PRECISION_LONG_DOUBLE is ", Math::MPFR::_have_extended_precision_long_double(), "\n";


print "1..43\n";

my $arb = 40;
Rmpfr_set_default_prec($arb);

my @bytes;
my $dd = 0;

eval {@bytes = Math::MPFR::_ld_bytes('2.3', 64);};

if($@) {

  my $mess = $@;

  my $nv1 = 1.0;
  my $nv2 = $nv1 + (2 ** -1000);
  $dd = 1 if $nv2 != $nv1;

  my $bits;
  $bits = Math::MPFR::_required_ldbl_mant_dig() == 2098 ? 106 : Math::MPFR::_required_ldbl_mant_dig();

  if((defined($Config{longdblkind}) && $Config{longdblkind} == 6) || $dd == 1) {
    warn "\ndouble-double detected\n";
    if($mess =~ /^2nd arg \(/) {print "ok 1\n"}
    else {
      warn "\n\$\@: $mess\n";
      print "not ok 1\n";
    }
  }
  elsif(64 != $bits) {
    warn "\n$bits != 64\n";
    if($mess =~ /^2nd arg \(/) {print "ok 1\n"}
    else {
      warn "\n\$\@: $mess\n";
      print "not ok 1\n";
    }
  }
  else {
    warn "\n\$\@: $mess\n";
    print "not ok 1\n";
  }

  warn "\nSkipping tests 2-4\n";
  print "ok 2\nok 3\nok 4\n";

}
else {

  my $hex = join '', @bytes;

  if($hex eq '40009333333333333333') {print "ok 1\n"}
  else {
    warn "expected 40009333333333333333, got $hex";
    print "not ok 1\n";
  }

  @bytes = Math::MPFR::_ld_bytes('2.93', 64);
  $hex = join '', @bytes;

  if($hex eq '4000bb851eb851eb851f') {print "ok 2\n"}
  else {
    warn "expected 4000bb851eb851eb851f, got $hex";
    print "not ok 2\n";
  }

  eval{Math::MPFR::_ld_bytes('2.93', 63);};

  if($@ =~ /^2nd arg to Math::MPFR::_ld_bytes must be 64/) {print "ok 3\n"}
  else {
    warn "\nIn Math::MPFR::_ld_bytes: $@\n";
    print "not ok 3\n";
  }

  eval{Math::MPFR::_ld_bytes(2.93, 64);};

  if($@ =~ /^1st arg supplied to Math::MPFR::_ld_bytes is not a string/) {print "ok 4\n"}
  else {
    warn "\nIn Math::MPFR::_ld_bytes: $@\n";
    print "not ok 4\n";
  }

}

#####################################################
#####################################################

eval {@bytes = Math::MPFR::_f128_bytes('2.3', 113);};

if($@) {

  my $mess = $@;

  if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
    if($mess =~ /^__float128 support not built into this Math::MPFR/) {print "ok 5\n"}
    else {
      warn "\n\$\@: $mess\n";
      print "not ok 5\n";
    }
  }
  elsif(113 != MPFR_FLT128_DIG) {
    my $dig = MPFR_FLT128_DIG;
    warn "\n$dig != 113\n";
    if($mess =~ /^2nd arg \(/) {print "ok 5\n"}
    else {
      warn "\n\$\@: $mess\n";
      print "not ok 5\n";
    }
  }
  else {
    warn "\n\$\@: $mess\n";
    print "not ok 5\n";
  }

  warn "\nSkipping tests 6-8\n";
  print "ok 6\nok 7\nok 8\n";

}
else {

  my $hex = join '', @bytes;

  if($hex eq '40002666666666666666666666666666') {print "ok 5\n"}
  else {
    warn "expected 40002666666666666666666666666666, got $hex";
    print "not ok 5\n";
  }

  @bytes = Math::MPFR::_f128_bytes('2.93', 113);
  $hex = join '', @bytes;

  if($hex eq '4000770a3d70a3d70a3d70a3d70a3d71') {print "ok 6\n"}
  else {
    warn "expected 4000770a3d70a3d70a3d70a3d70a3d71, got $hex";
    print "not ok 6\n";
  }

  eval{Math::MPFR::_f128_bytes('2.93', 63);};

  if($@ =~ /^2nd arg to Math::MPFR::_f128_bytes must be 113/) {print "ok 7\n"}
  else {
    warn "\nIn Math::MPFR::_f128_bytes: $@\n";
    print "not ok 7\n";
  }

  eval{Math::MPFR::_f128_bytes(2.93, 113);};

  if($@ =~ /^1st arg supplied to Math::MPFR::_f128_bytes is not a string/) {print "ok 8\n"}
  else {
    warn "\nIn Math::MPFR::_f128_bytes: $@\n";
    print "not ok 8\n";
  }

}

my $now = Rmpfr_get_default_prec();

if($now == $arb) {print "ok 9\n"}
else {
  warn "Default precision has changed from $arb to $now\n";
  print "not ok 9\n";
}

@bytes = Math::MPFR::_d_bytes('1e+129', 53);

my $hex = join '', @bytes;

my $double = Math::MPFR::Rmpfr_init2(53);
Math::MPFR::Rmpfr_set_str($double, '1e+129', 10, 0);

unless($] < 5.01) { # perl-5.8 and earlier don't understand 'pack "d<"'.

  my $hex2 = scalar reverse unpack "h*", pack "d<", Math::MPFR::Rmpfr_get_d($double, 0);

  if($hex eq $hex2) {print "ok 10\n"}
  else {
    warn "expected $hex, got $hex2\n";
    print "not ok 10\n";
  }
}
else {
  warn "\nSkipping test 10 for perl-5.9 and earlier\n";
  print "ok 10\n";
}

my @bytes2;

eval{@bytes = Math::MPFR::_d_bytes('23.75', 53);};

if(!$@) {
  @bytes2 = Math::MPFR::_d_bytes('0x17.c', 53);
  my $one = join '', @bytes;
  my $two = join '', @bytes2;
  if($one eq $two) {print "ok 11\n"}
  else {
    warn "\nexpected *$one*\n     got *$two*\n";
    print "not ok 11\n";
  }
}
else {
  warn "Skipping test 11 - $@\n";
  print "ok 11\n";
}

eval{@bytes = Math::MPFR::_ld_bytes('23.75', 64);};

if(!$@) {
  @bytes2 = Math::MPFR::_ld_bytes('0X17.C', 64);
  my $one = join '', @bytes;
  my $two = join '', @bytes2;
  if($one eq $two) {print "ok 12\n"}
  else {
    warn "\nexpected *$one*\n     got *$two*\n";
    print "not ok 12\n";
  }
}
else {
  warn "Skipping test 12 - $@\n";
  print "ok 12\n";
}

eval{@bytes = Math::MPFR::_f128_bytes('23.75', 113);};

if(!$@) {
 @bytes2 = Math::MPFR::_f128_bytes('0X17.c', 113);
  my $one = join '', @bytes;
  my $two = join '', @bytes2;
  if($one eq $two) {print "ok 13\n"}
  else {
    warn "\nexpected *$one*\n     got *$two*\n";
    print "not ok 13\n";
  }
}
else {
  warn "Skipping test 13 - $@\n";
  print "ok 13\n";
}

my $fr_breaker = Rmpfr_init2(200);
Rmpfr_set_str($fr_breaker, '1.1', 10, MPFR_RNDN);

eval {Math::MPFR::_d_bytes_fr($fr_breaker, 53);};

if($@ =~ /^Precison of 1st arg supplied to _d_bytes_fr must be 53, not 200/) {print "ok 14\n"}
else {
  warn "\$\@: $@\n";
  print "not ok 14\n";
}

eval {Math::MPFR::_dd_bytes_fr($fr_breaker, 106);};

if($@ =~ /^Precison of 1st arg supplied to _dd_bytes_fr must be 2098, not 200/) {print "ok 15\n"}
else {
  warn "\$\@: $@\n";
  print "not ok 15\n";
}

eval {Math::MPFR::_ld_bytes_fr($fr_breaker, 64);};


if($@ =~ /^Precison of 1st arg \(200\) supplied to _ld_bytes_fr must match 2nd arg \(64\)/) {print "ok 16\n"}
else {
  warn "\$\@: $@\n";
  print "not ok 16\n";
}

eval {Math::MPFR::_f128_bytes_fr($fr_breaker, 113);};

if($@ =~ /^Precison of 1st arg supplied to _f128_bytes_fr must be 113, not 200/ ||
   $@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 17\n"}
else {
  warn "\$\@: $@\n";
  print "not ok 17\n";
}

my $d_fr = Rmpfr_init2(53);
Rmpfr_set_str($d_fr, '1e+127', 10, MPFR_RNDN);

my $expected = join '', Math::MPFR::_d_bytes_fr($d_fr, 53);

if($expected eq '5a4d8ba7f519c84f') {print "ok 18\n"}
else {
  warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n";
  print "not ok 18\n";
}

my $dd_fr = Rmpfr_init2(2098);
Rmpfr_set_str($dd_fr, '1e+127', 10, MPFR_RNDN);

$expected = join '', Math::MPFR::_dd_bytes_fr($dd_fr, 106);

if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 19\n"}
else {
  warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n";
  print "not ok 19\n";
}


my $ld_fr = Rmpfr_init2(64);
Rmpfr_set_str($ld_fr, '1e+127', 10, MPFR_RNDN);

eval {$expected = join '', Math::MPFR::_ld_bytes_fr($ld_fr, 64);};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {
  warn "LDBL_MANT_DIG: ", Math::MPFR::_required_ldbl_mant_dig() == 2098 ? 106 : Math::MPFR::_required_ldbl_mant_dig(), "\n";
  print "ok 20\n";
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 20\n";
}
elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 20\n"}
else {
  warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n";
  print "not ok 20\n";
}

my $f128_fr = Rmpfr_init2(113);
Rmpfr_set_str($f128_fr, '1e+127', 10, MPFR_RNDN);

eval {$expected = join '', Math::MPFR::_f128_bytes_fr($f128_fr, 113);};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 21\n"}
  else {
    warn "\n\$\@\: $@\n";
    print "not ok 21\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 21\n";
}
elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 21\n"}
else {
  warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n";
  print "not ok 21\n";
}

my $h;

eval{$h = Math::MPFR::bytes($d_fr, 'Long Double');};

if($@ =~ /^Precison of 1st arg \(53\) supplied to _ld_bytes_fr must match 2nd arg \(64\)/) {print "ok 22\n"}
else {
  warn "\$\@: $@";
  print "not ok 22\n";
}

eval{$h = Math::MPFR::bytes($d_fr, 53);};

if($@ =~ /^2nd arg to Math::MPFR::bytes must be/) {print "ok 23\n"}
else {
  warn "\$\@: $@";
  print "not ok 23\n";
}

$expected = Math::MPFR::bytes($d_fr, 'Double');

if($expected eq '5a4d8ba7f519c84f') {print "ok 24\n"}
else {
  warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n";
  print "not ok 24\n";
}

$expected = Math::MPFR::bytes('1e+127', 'Double');

if($expected eq '5a4d8ba7f519c84f') {print "ok 25\n"}
else {
  warn "Expected *5a4d8ba7f519c84f*, got *$expected*\n";
  print "not ok 25\n";
}

eval {$expected = Math::MPFR::bytes($ld_fr, 'Long Double');};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 26\n"}
elsif($@) {
  warn "\$\@: $@\n";
  print "not ok 26\n";
}
elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 26\n"}
else {
  warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n";
  print "not ok 26\n";
}

eval {$expected = Math::MPFR::bytes('1e+127', 'Long Double');};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes does not match LDBL_MANT_DIG/) {print "ok 27\n"}
elsif($@) {
  warn "\$\@: $@\n";
  print "not ok 27\n";
}
elsif($expected eq '41a4ec5d3fa8ce427b00') {print "ok 27\n"}
else {
  warn "Expected *41a4ec5d3fa8ce427b00*, got *$expected*\n";
  print "not ok 27\n";
}

$expected = Math::MPFR::bytes($dd_fr, 'Double-Double');

if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 28\n"}
else {
  warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n";
  print "not ok 28\n";
}

$expected = Math::MPFR::bytes('1e+127', 'Double-Double');

if($expected eq '5a4d8ba7f519c84f56e7fd1f28f89c56') {print "ok 29\n"}
else {
  warn "Expected *5a4d8ba7f519c84f56e7fd1f28f89c56*, got *$expected*\n";
  print "not ok 29\n";
}

eval{$expected = Math::MPFR::bytes($f128_fr, '__Float128');};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 30\n"}
  else {
    warn "\n\$\@\: $@";
    print "not ok 30\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 30\n";
}
elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 30\n"}
else {
  warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n";
  print "not ok 30\n";
}

eval{$expected = Math::MPFR::bytes('1e+127', '__Float128');};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 31\n"}
  else {
    warn "\n\$\@\: $@";
    print "not ok 31\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 31\n";
}
elsif($expected eq '41a4d8ba7f519c84f5ff47ca3e27156a') {print "ok 31\n"}
else {
  warn "Expected *41a4d8ba7f519c84f5ff47ca3e27156a*, got *$expected*\n";
  print "not ok 31\n";
}

my $unity = Math::MPFR->new(1);

Rmpfr_exp($d_fr,    $unity, MPFR_RNDN);
Rmpfr_exp($dd_fr,   $unity, MPFR_RNDN);
Rmpfr_exp($ld_fr,   $unity, MPFR_RNDN);
Rmpfr_exp($f128_fr, $unity, MPFR_RNDN);

$expected = Math::MPFR::bytes($d_fr, 'double');

if($expected eq '4005bf0a8b145769') {print "ok 32\n"}
else {
  warn "expected *4005bf0a8b145769*, got *$expected*\n";
  print "not ok 32\n";
}

$expected = Math::MPFR::bytes($dd_fr, 'Double-double');

if($expected eq '4005bf0a8b1457693ca4d57ee2b1013a') {print "ok 33\n"}
else {
  warn "expected *4005bf0a8b1457693ca4d57ee2b1013a*, got *$expected*\n";
  print "not ok 33\n";
}

eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 34\n"}
elsif($@) {
  warn "\$\@: $@\n";
  print "not ok 34\n";
}
elsif($expected eq '4000adf85458a2bb4a9b') {print "ok 34\n"}
else {
  warn "expected *4000adf85458a2bb4a9b*, got *$expected*\n";
  print "not ok 34\n";
}

eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 35\n"}
  else {
    warn "\n\$\@\: $@";
    print "not ok 35\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 35\n";
}
elsif($expected eq '40005bf0a8b1457695355fb8ac404e7a') {print "ok 35\n"}
else {
  warn "expected *40005bf0a8b1457695355fb8ac404e7a*, got *$expected*\n";
  print "not ok 35\n";
}

Rmpfr_const_pi($d_fr,    MPFR_RNDN);
Rmpfr_const_pi($dd_fr,   MPFR_RNDN);
Rmpfr_const_pi($ld_fr,   MPFR_RNDN);
Rmpfr_const_pi($f128_fr, MPFR_RNDN);

$expected = Math::MPFR::bytes($d_fr, 'double');

if($expected eq '400921fb54442d18') {print "ok 36\n"}
else {
  warn "expected *400921fb54442d18*, got *$expected*\n";
  print "not ok 36\n";
}

$expected = Math::MPFR::bytes($dd_fr, 'Double-double');

if($expected eq '400921fb54442d183ca1a62633145c07') {print "ok 37\n"}
else {
  warn "expected *400921fb54442d183ca1a62633145c07*, got *$expected*\n";
  print "not ok 37\n";
}

eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 38\n"}
elsif($@) {
  warn "\$\@: $@\n";
  print "not ok 38\n";
}
elsif($expected eq '4000c90fdaa22168c235') {print "ok 38\n"}
else {
  warn "expected *4000c90fdaa22168c235*, got *$expected*\n";
  print "not ok 38\n";
}

eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 39\n"}
  else {
    warn "\n\$\@\: $@";
    print "not ok 39\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 39\n";
}
elsif($expected eq '4000921fb54442d18469898cc51701b8') {print "ok 39\n"}
else {
  warn "expected *4000921fb54442d18469898cc51701b8*, got *$expected*\n";
  print "not ok 39\n";
}

Rmpfr_set_si($d_fr,    2, MPFR_RNDN);
Rmpfr_set_si($dd_fr,   2, MPFR_RNDN);
Rmpfr_set_si($ld_fr,   2, MPFR_RNDN);
Rmpfr_set_si($f128_fr, 2, MPFR_RNDN);

Rmpfr_sqrt($d_fr,    $d_fr,    MPFR_RNDN);
Rmpfr_sqrt($dd_fr,   $dd_fr,   MPFR_RNDN);
Rmpfr_sqrt($ld_fr,   $ld_fr,   MPFR_RNDN);
Rmpfr_sqrt($f128_fr, $f128_fr, MPFR_RNDN);

$expected = Math::MPFR::bytes($d_fr, 'double');

if($expected eq '3ff6a09e667f3bcd') {print "ok 40\n"}
else {
  warn "expected *3ff6a09e667f3bcd*, got *$expected*\n";
  print "not ok 40\n";
}

$expected = Math::MPFR::bytes($dd_fr, 'Double-double');

if($expected eq '3ff6a09e667f3bcdbc9bdd3413b26456') {print "ok 41\n"}
else {
  warn "expected *3ff6a09e667f3bcdbc9bdd3413b26456*, got *$expected*\n";
  print "not ok 41\n";
}

eval {$expected = Math::MPFR::bytes($ld_fr, 'Long double');};

if(Math::MPFR::_required_ldbl_mant_dig() != 64 && $@ =~ /^2nd arg \(64\) supplied to Math::MPFR::_ld_bytes_fr does not match LDBL_MANT_DIG/) {print "ok 42\n"}
elsif($@) {
  warn "\$\@: $@\n";
  print "not ok 42\n";
}
elsif($expected eq '3fffb504f333f9de6484') {print "ok 42\n"}
else {
  warn "expected *3fffb504f333f9de6484*, got *$expected*\n";
  print "not ok 42\n";
}

eval{$expected = Math::MPFR::bytes($f128_fr, '__float128');};

if(!Math::MPFR::_MPFR_WANT_FLOAT128()) {
  if($@ =~ /^__float128 support not built into this Math::MPFR/) {print "ok 43\n"}
  else {
    warn "\n\$\@\: $@";
    print "not ok 43\n";
  }
}
elsif($@) {
  warn "\$\@:$@\n";
  print "not ok 43\n";
}
elsif($expected eq '3fff6a09e667f3bcc908b2fb1366ea95') {print "ok 43\n"}
else {
  warn "expected *3fff6a09e667f3bcc908b2fb1366ea95*, got *$expected*\n";
  print "not ok 43\n";
}


__END__

e:
4005bf0a8b145769
4000adf85458a2bb4a9b
4005bf0a8b1457693ca4d57ee2b1013a
40005bf0a8b1457695355fb8ac404e7a

pi:
400921fb54442d18
4000c90fdaa22168c235
400921fb54442d183ca1a62633145c07
4000921fb54442d18469898cc51701b8

sqrt(2):
3ff6a09e667f3bcd
3fffb504f333f9de6484
3ff6a09e667f3bcdbc9bdd3413b26456
3fff6a09e667f3bcc908b2fb1366ea95