use warnings;
use strict;
use Math::MPFR qw(:mpfr);

my $cut = eval 'use threads; 1';

print "1..3\n";

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

if($cut) {
  if($threads::VERSION < 1.71) {
    warn "Skipping all tests - need at least threads-1.71, we have version $threads::VERSION\n";
    print "ok 1\n";
    print "ok 2\n";
    print "ok 3\n";
    exit(0);
  }
}

my ($tls, $ok, $pid);
eval {$tls =  Rmpfr_buildopt_tls_p();};

my $cut_mess = $cut ? '' : "ithreads not available with this build of perl\n";
my $tls_mess = $tls ? '' :
                           $@ ? "Unable to determine whether mpfr was built with '--enable-thread-safe'\n"
                              : "Your mpfr library was not built with '--enable-thread-safe'\n";

if($cut && $tls) {   # perform tests

  Rmpfr_set_default_prec(101);
  my $thr1 = threads->create(
                      sub {
                          Rmpfr_set_default_prec(201);
                          return Rmpfr_get_default_prec();
                          } );
  my $res = $thr1->join();

  if($res == 201 && Rmpfr_get_default_prec() == 101) {$ok .= 'a'}
  else {warn "\n1a: \$res: $res\n    prec: ", Rmpfr_get_default_prec(), "\n"}

  # Needs TLS to work correctly on MS Windows
  if($pid = fork()) {
    Rmpfr_set_default_prec(102);
    waitpid($pid,0);
  } else {
    sleep 1;
    Rmpfr_set_default_prec(202);
    _save(Rmpfr_get_default_prec());
    exit(0);
  }

  sleep 2;

  if(Rmpfr_get_default_prec() == 102) {$ok .= 'b'}
  else {warn "\n1b: prec: ", Rmpfr_get_default_prec(), "\n"}

  my $f = _retrieve();

  if($f == 999999) {
    warn "Skipping test 1c - couldn't open 'save_child_setting.txt'";
    $ok .= 'c';
  }
  elsif($f == 202) {
    $ok .= 'c';
  }
  else {
    warn "\n1c: prec: $f\n";
  }

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

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

  $ok = '';

  Rmpfr_set_default_rounding_mode(GMP_RNDZ);
  my $thr2 = threads->create(
                      sub {
                          Rmpfr_set_default_rounding_mode(GMP_RNDU);
                          return Rmpfr_get_default_rounding_mode();
                          } );
  $res = $thr2->join();

  if($res == GMP_RNDU && Rmpfr_get_default_rounding_mode() == GMP_RNDZ) {$ok .= 'a'}
  else {warn "\n2a: \$res: $res\n    rounding: ", Rmpfr_get_default_rounding_mode(), "\n"}

  # Needs TLS to work correctly on MS Windows
  if($pid = fork()) {
    Rmpfr_set_default_rounding_mode(GMP_RNDU);
    waitpid($pid,0);
  } else {
    sleep 1;
    Rmpfr_set_default_rounding_mode(GMP_RNDD);
    _save(Rmpfr_get_default_rounding_mode());
    exit(0);
  }

  sleep 2;

  if(Rmpfr_get_default_rounding_mode() == GMP_RNDU) {$ok .= 'b'}
  else {warn "\n2b: rounding: ", Rmpfr_get_default_rounding_mode(), "\n"}

  $f = _retrieve();

  if($f == 999999) {
    warn "Skipping test 2c - couldn't open 'save_child_setting.txt'";
    $ok .= 'c';
  }
  elsif($f == GMP_RNDD) {
    $ok .= 'c';
  }
  else {
    warn "\n2c: rounding: $f\n";
  }

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

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

  $ok = '';

  Rmpfr_set_default_rounding_mode(GMP_RNDN);
  Rmpfr_set_default_prec(103);
  my $thr3 = threads->create(
                          {'context' => 'list'},
                      sub {
                          Rmpfr_set_default_prec(203);
                          Rmpfr_set_default_rounding_mode(GMP_RNDU);
                          return (Rmpfr_get_default_prec(), Rmpfr_get_default_rounding_mode());
                          } );
  my @res = $thr3->join();

  if($res[0] == 203 && $res[1] == GMP_RNDU && Rmpfr_get_default_prec() == 103 && Rmpfr_get_default_rounding_mode() == GMP_RNDN) {$ok .= 'a'}
  else {warn "\n3a: \$res[0]: $res[0]\n \$res[1]: $res[1]\n    prec: ", Rmpfr_get_default_prec(), "\n    rounding: ", Rmpfr_get_default_rounding_mode(), "\n"}

  # Needs TLS to work correctly on MS Windows
  if($pid = fork()) {
    Rmpfr_set_default_prec(104);
    Rmpfr_set_default_rounding_mode(GMP_RNDU);
    waitpid($pid,0);
  } else {
    sleep 1;
    Rmpfr_set_default_prec(204);
    Rmpfr_set_default_rounding_mode(GMP_RNDD);
    my $p = Rmpfr_get_default_prec();
    my $r = Rmpfr_get_default_rounding_mode();
    _save("$p $r");
    exit(0);
  }

  sleep 2;

  if(Rmpfr_get_default_rounding_mode() == GMP_RNDU && Rmpfr_get_default_prec() == 104) {$ok .= 'b'}
  else {warn "\n3b: prec: ", Rmpfr_get_default_prec(), "\n rounding: ", Rmpfr_get_default_rounding_mode(), "\n"}

  my @f = _retrieve();

  if($f[0] == 999999) {
    warn "Skipping test 3c - couldn't open 'save_child_setting.txt'";
    $ok .= 'c';
  }
  elsif($f[0] == 204 && $f[1] == GMP_RNDD) {
    $ok .= 'c';
  }
  else {
    warn "\n3c: prec: $f[0]  rounding: $f[1]\n";
  }

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

  #######################
}
else {
  warn "Skipping all tests: ${cut_mess}${tls_mess}";
  print "ok 1\n";
  print "ok 2\n";
  print "ok 3\n";
}


sub _save {
    unless (open(WR, '>', 'save_child_setting.txt')) {
      warn "Can't open file 'save_child_setting.txt' for writing : $!";
      return 0;
    }
    print WR $_[0];
    return 1;
}

sub _retrieve {
    unless (open (RD, '<', 'save_child_setting.txt')) {
      warn "Can't open file 'save_child_setting.txt' for reading: $!";
      return 999999;
    }
    my @ret;
    my $ret = <RD>;
    chomp $ret;
    if($ret =~ / /) {
      @ret = split / /, $ret;
      return @ret;
    }
    return $ret;
}