The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Some adhoc tests to check that signed zeroes are being dealt with correctly.
# By no means exhaustive tests - they just deal with a known issue with
# 64-bit builds and overloaded mul and div operations (which  should now be fixed).

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

print "1..5\n";

my $ok;
my $z = Math::MPC->new(0, 0);
my $mul = -1;

my $x = $z * $mul;
if(Math::MPC::overload_string($x) eq '(-0 -0)') {$ok .= 'a'}
else {warn "\n1a: got '",Math::MPC::overload_string($x), "'\nexpected '(-0 -0)'\n"}

my $y = $z / $mul;
if(Math::MPC::overload_string($y) eq '(-0 -0)') {$ok .= 'b'}
else {warn "\n1b: got '",Math::MPC::overload_string($y), "'\nexpected '(-0 -0)'\n"}

$z *= $mul;
if(Math::MPC::overload_string($z) eq '(-0 -0)') {$ok .= 'c'}
else {warn "\n1c: got '",Math::MPC::overload_string($z), "'\nexpected '(-0 -0)'\n"}

$z *= $mul;
if(Math::MPC::overload_string($z) eq '(0 0)') {$ok .= 'd'}
else {warn "\n1d: got '",Math::MPC::overload_string($z), "'\nexpected '(0 0)'\n"}

$z /= $mul;
if(Math::MPC::overload_string($z) eq '(-0 -0)') {$ok .= 'e'}
else {warn "\n1e: got '",Math::MPC::overload_string($z), "'\nexpected '(-0 -0)'\n"}

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

$ok = '';
Rmpc_set_ui_ui($z, 0, 0, MPC_RNDNN);
$mul = -10.625;

$x = $z * $mul;
if(Math::MPC::overload_string($x) eq '(-0 -0)') {$ok .= 'a'}
else {warn "\n2a: got '",Math::MPC::overload_string($x), "'\nexpected '(-0 -0)'\n"}

$y = $z / $mul;
if(Math::MPC::overload_string($y) eq '(-0 -0)') {$ok .= 'b'}
else {warn "\n2b: got '",Math::MPC::overload_string($y), "'\nexpected '(-0 -0)'\n"}

$z *= $mul;
if(Math::MPC::overload_string($z) eq '(-0 -0)') {$ok .= 'c'}
else {warn "\n2c: got '",Math::MPC::overload_string($z), "'\nexpected '(-0 -0)'\n"}

$z *= $mul;
if(Math::MPC::overload_string($z) eq '(0 0)') {$ok .= 'd'}
else {warn "\n2d: got '",Math::MPC::overload_string($z), "'\nexpected '(0 0)'\n"}

$z /= $mul;
if(Math::MPC::overload_string($z) eq '(-0 -0)') {$ok .= 'e'}
else {warn "\n2e: got '",Math::MPC::overload_string($z), "'\nexpected '(-0 -0)'\n"}

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

$ok = '';
my $_64i = Math::MPC::_has_longlong();
my $_64d = Math::MPC::_has_longdouble();

my $long = -15;
my $double = -2.5;
Rmpc_set_ui_ui($z, 10, 8, MPC_RNDNN);
my $rop = Math::MPC->new();
my $check = Math::MPFR->new();

Rmpc_mul_d($rop, $z, $double, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'a' if $check == -25;
RMPC_IM($check, $rop);
$ok .= 'b' if $check == -20;

Rmpc_div_d($rop, $rop, $double, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'c' if $check == 10;
RMPC_IM($check, $rop);
$ok .= 'd' if $check == 8;

Rmpc_d_div($rop, $double, $z, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'e' if ($check > -1.524390244e-1  && $check < -1.5243902439e-1) ;
RMPC_IM($check, $rop);
$ok .= 'f' if ($check < 0.12195122 && $check > 0.1219512195);

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

$ok = '';

if($_64i) {
Rmpc_mul_sj($rop, $z, $long, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'a' if $check == -150;
RMPC_IM($check, $rop);
$ok .= 'b' if $check == -120;

Rmpc_div_sj($rop, $rop, $long, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'c' if $check == 10;
RMPC_IM($check, $rop);
$ok .= 'd' if $check == 8;

Rmpc_sj_div($rop, $long, $z, MPC_RNDNN);
# (-9.1463414634146345e-1 7.3170731707317072e-1)
RMPC_RE($check, $rop);
$ok .= 'e' if ($check < -9.14634e-1 && $check > -9.1463415e-1) ;
RMPC_IM($check, $rop);
$ok .= 'f' if ($check < 7.3170732e-1 && $check > 7.3170731e-1);

if($ok eq 'abcdef') {print "ok 4\n"}
else {
  warn "\$ok: $ok\n";
  print "not ok 4 \n";
}
}
else {
  warn "Skipping test 4 - no 64 bit int support\n";
  print "ok 4\n";
}

$ok = '';

if($_64d) {
Rmpc_mul_ld($rop, $z, $double, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'a' if $check == -25;
RMPC_IM($check, $rop);
$ok .= 'b' if $check == -20;

Rmpc_div_ld($rop, $rop, $double, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'c' if $check == 10;
RMPC_IM($check, $rop);
$ok .= 'd' if $check == 8;

Rmpc_ld_div($rop, $double, $z, MPC_RNDNN);
RMPC_RE($check, $rop);
$ok .= 'e' if ($check > -1.524390244e-1  && $check < -1.5243902439e-1) ;
RMPC_IM($check, $rop);
$ok .= 'f' if ($check < 0.12195122 && $check > 0.1219512195);

if($ok eq 'abcdef') {print "ok 5\n"}
else {
  warn "\$ok: $ok\n";
  print "not ok 5 \n";
}
}
else {
  warn "Skipping test 5 - no long double support\n";
  print "ok 5\n";
}