The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Math::NV qw(:all);

my $tests = 4;

print "1..$tests\n";

if(mant_dig() != 64 && mant_dig() != 106) {
  warn "Skipping tests - they don't accommodate an NV\n that has a ", mant_dig(), "-bit mantissa\n\n";
  for(1 .. $tests) {print "ok $_\n";}
  exit 0;
}

my $needed = 0;
my $ok = 1;

my $correct1 = mant_dig() == 64 ? '0.100001011111000001000110100000101001001111110000111010110100111e-989'
                                : '0.1000010111110000010001101000001010010011111100001110101101001110001001011011101111111e-989';

my $correct2 = mant_dig() == 64 ? '0.100001111100010100001111010111100010100000101000011001e-953'
                                : '0.1000011111000101000011110101111000101000001010000110001111111111101010100101000000111011010110110010111011e-953';

my $str1 = '1e-298';
my $str2 = '69659e-292';

warn "Setting \$nv to $str1\n";

#################################
my $nv = $str1;

if($nv == nv($str1)) {
  warn"1. Perl and C agree that $str1 is $nv\n";
}
else {
  warn "1. Perl thinks that $str1 looks like ", float_bin($nv), "\n";
  warn "1. C    thinks that $str1 looks like ", float_bin(nv($str1)), "\n";
  $needed = 1;
}

if("$nv" eq $str1) {
  warn "2. \$nv stringifies to $str1 as expected\n";
}
else {
  warn "2. \$nv surprisingly stringifies to $nv\n";
  $needed = 1;
}

if(float_bin($nv) eq $correct1) {
  warn "3. $nv is ", float_bin($nv), " as expected\n";
}
else {
  warn "3. Perl sets $nv (wrongly) to ", float_bin($nv), "\n";
  $needed = 1;
}

if(float_bin(nv($str1)) ne $correct1) {
  warn "\$nv: $nv ", float_bin($nv), "\n";
  warn "nv(\$nv): ", nv("$nv"), " ", float_bin(nv("$nv")), "\n";
  $ok = 0;
}

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

$nv = $str2;

if($nv == nv($str2)) {
  warn"4. Perl and C agree that $str2 is $nv\n";
}
else {
  warn "4. Perl thinks that $str2 looks like ", float_bin($nv), "\n";
  warn "4. C    thinks that $str2 looks like ", float_bin(nv($str2)), "\n";
  $needed = 1;
}

if("$nv" eq $str2) {
  warn "5. \$nv stringifies to $str2 as expected\n";
}
else {
  warn "5. \$nv surprisingly stringifies to $nv\n";
  $needed = 1;
}

if(float_bin($nv) eq $correct2) {
  warn "6. $nv is ", float_bin($nv), " as expected\n";
}
else {
  warn "6. Perl sets $nv (wrongly) to ", float_bin($nv), "\n";
  $needed = 1;
}

if(float_bin(nv($str2)) ne $correct2) {
  warn "\$nv: $nv ", float_bin($nv), "\n";
  warn "nv(\$nv): ", nv("$nv"), " ", float_bin(nv("$nv")), "\n";
  $ok = 0;
}

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

if($correct1 eq str_bin($str1)) {print "ok 1\n"}
else {
 warn "Got:\n", str_bin($str1), "\nExpected:\n$correct1\n\n";
 print "not ok 1\n";
}

if($correct2 eq str_bin($str2)) {print "ok 2\n"}
else {
 warn "Got:\n", str_bin($str2), "\nExpected:\n$correct2\n\n";
 print "not ok 2\n";
}

if(float_bin(nv($str1)) eq $correct1) {print "ok 3\n"}
else {
  warn "Got:\n", float_bin(nv($str1)), "\nExpected:\n$correct1\n\n";
  print "not ok 3\n";
}


if(float_bin(nv($str2)) eq $correct2) {print "ok 4\n"}
else {
  warn "Got:\n", float_bin(nv($str2)), "\nExpected:\n$correct2\n\n";
  print "not ok 4\n";
}

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

if($ok) {
  my ($count, $t) = (0,0);
  warn "Looking for other discrepancies\n";
  for my $exp(10, 20, 30, 280 .. 300) {
    for my $digits(1..17) {
      $t++;
      my $nv = random_select($digits) . 'e' . "-$exp";
      #warn float_hex($nv), " ", float_hex(nv($nv)), "\n";
      if(float_bin($nv) ne float_bin(nv($nv))) {
        print "\$nv: $nv\n";
        print "perl:\n", float_bin($nv), "\nnv:\n", float_bin(nv($nv)), "\n\n";
        $count++;
      }
      else {print "\$nv: $nv ok\n\n";}
    }

  }
  warn "Found $count discrepancies in a further $t random(ish) tests\n";
}

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

if(!$needed) {
  warn "You don't need nv() for accurate representation of 1e-298 or 69659e-292\n\n";
}
elsif(!$ok) {
  warn "Perl sets an incorrect value for 1e-298 and/or 69659e-292 - unfortunately so, too, does nv()\n\n";
}
else {
 warn " For accurate representation of 1e-298 and/or 69659e-292 (and presumably many other values),\n you need something like nv()\n\n";
}

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

sub float_bin {
  my @in = ld2binary($_[0], 0);
  return $in[0] . 'e' . $in[1];
}

sub str_bin {
  my @in = ld_str2binary($_[0], 0);
  return $in[0] . 'e' . $in[1];
}


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