use warnings;
use strict;
use Math::MPFR qw(:mpfr);
my $t = 11;
print "1..$t\n";
eval {require Math::LongDouble;};
my $mant_dig = Math::MPFR::_LDBL_MANT_DIG(); # expected to be either 64 or 106
my $ldbl_dig = Math::MPFR::_LDBL_DIG();
my $def_prec = 6 + $mant_dig;
unless($@ || $Math::LongDouble::VERSION < 0.02) {
Rmpfr_set_default_prec($def_prec);
my($ld_1, $ld_2) = (Math::LongDouble->new('1.123'), Math::LongDouble->new());
my $fr_plus6 = Math::MPFR->new();
my $fr_true = Rmpfr_init2($mant_dig);
my ($man, $exp);
Rmpfr_set_LD($fr_plus6, $ld_1, MPFR_RNDN);
Rmpfr_get_LD($ld_2, $fr_plus6, MPFR_RNDN);
if($ld_1 && $ld_1 == $ld_2) {print "ok 1\n"}
else {
warn "\$ld_1: $ld_1\n\$ld_2: $ld_2\n";
print "not ok 1\n";
}
# The following binary strings represent the mantissa for 1e-37 (for varous precisions)
# Precision = 112 or 70:
my $str_plus6 = $mant_dig == 106
? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111011010'
: '1000100000011100111010100001010001010100010111000111010101110101100000';
# Precision = 106 or 64 (but derived from the relevant above representation).
my $m_plus6_to_actual = $mant_dig == 106
? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111'
: '1000100000011100111010100001010001010100010111000111010101110110';
# Precision = 106 or 64 (actual correct 106/64-bit representation).
my $m_actual = $mant_dig == 106
? '1000100000011100111010100001010001010100010111000111010101110101011111100101000011010110010000010111011111'
: '1000100000011100111010100001010001010100010111000111010101110101';
my $ld_check = Math::LongDouble->new('1e-37');
Rmpfr_set_str($fr_plus6, '1@-37', 10, MPFR_RNDN);
Rmpfr_set_str($fr_true, '1@-37', 10, MPFR_RNDN);
($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN);
print "\$man:\n$man\n\n";
#####################################################
# $ld_2, derived from $fr_true should == $ld_check #
#####################################################
Rmpfr_get_LD($ld_2, $fr_true, MPFR_RNDN);
$man = get_man($ld_2);
if($man eq ('1.' . ('0' x ($ldbl_dig - 1)))) {print "ok 2\n"}
else {
warn "\n\$man: $man\n";
print "not ok 2\n";
}
if($ld_check == $ld_2) {print "ok 3\n"}
else {
warn "\n\$ld_check: $ld_check\n\$ld_2: $ld_2\n";
print "not ok 3\n";
}
$man = get_manp($ld_2, $ldbl_dig + 1);
if($man eq ('9.' . ('9' x $ldbl_dig))) {print "ok 4\n"}
else {
warn "\n\$man: $man\n";
print "not ok 4\n";
}
#####################################################
# $ld_2, derived from $fr_plus6 should != $ld_check #
#####################################################
Rmpfr_get_LD($ld_2, $fr_plus6, MPFR_RNDN);
$man = get_man($ld_2);
if($man eq ('1.' . ('0' x ($ldbl_dig - 1)))) {print "ok 5\n"}
else {
warn "\n\$man: $man\n";
print "not ok 5\n";
}
if($ld_check != $ld_2) {print "ok 6\n"}
else {
warn "\n\$ld_check: $ld_check\n\$ld_2: $ld_2\n";
print "not ok 6\n";
}
$man = get_manp($ld_2, 19);
if($man eq '1.000000000000000000') {print "ok 7\n"}
else {
warn "\n\$man: $man\n";
print "not ok 7\n";
}
##################################################################################
# Mantissa of $fr_plus6, rounded to $mant_dig bits should eq $m_plus6_to_actual #
##################################################################################
($man, $exp) = Rmpfr_deref2($fr_plus6, 2, $mant_dig, MPFR_RNDN);
if($man eq $m_plus6_to_actual) {print "ok 8\n"}
else {
warn "\n\$man: $man\n $m_plus6_to_actual\n";
print "not ok 8\n";
}
####################################################################
# $mant_dig-bit mantissa of $fr_true should eq $m_actual #
####################################################################
($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN);
if($man eq $m_actual) {print "ok 9\n"}
else {
warn "\n\$man: $man\n\$m_actual: $m_actual\n";
print "not ok 9\n";
}
Rmpfr_set_str($fr_plus6, $str_plus6, 2, MPFR_RNDN);
##################################################################################
# Mantissa of $fr_plus6, rounded to $mant_dig bits should eq $m_plus6_to_actual #
##################################################################################
($man, $exp) = Rmpfr_deref2($fr_plus6, 2, $mant_dig, MPFR_RNDN);
if($man eq $m_plus6_to_actual) {print "ok 10\n"}
else {
warn "\n\$man: $man\n $m_plus6_to_actual\n";
print "not ok 10\n";
}
Rmpfr_set_str($fr_true, $str_plus6, 2, MPFR_RNDN);
#################################################################################
# Mantissa of $fr_true, rounded to $mant_dig bits should eq $m_plus6_to_actual #
#################################################################################
($man, $exp) = Rmpfr_deref2($fr_true, 2, $mant_dig, MPFR_RNDN);
if($man eq $m_plus6_to_actual) {print "ok 11\n"}
else {
warn "\n\$man: $man\n $m_plus6_to_actual\n";
print "not ok 11\n";
}
}
else {
warn "\nSkipping all tests - couldn't load Math-LongDouble-0.02 (or later)\n";
for(1 .. $t) {print "ok $_\n"}
}
sub get_man {
return (split /e/i, Math::LongDouble::LDtoSTR($_[0]))[0];
}
sub get_manp {
return (split /e/i, Math::LongDouble::LDtoSTRP($_[0], $_[1]))[0];
}