static void
check_ternary_value (void)
{
mpfr_prec_t prec;
mpc_t z;
const long int s = -1;
mpc_init2 (z, 2);
for (prec=2; prec <= 1024; prec++) {
mpc_set_prec (z, prec);
mpc_set_ui (z, 3ul, MPC_RNDNN);
if (mpc_add_si (z, z, s, MPC_RNDDU)) {
printf ("Error in mpc_add_si: 3+(-1) should be exact\n");
exit (1);
}
else if (mpc_cmp_si (z, 2l) != 0) {
printf ("Error in mpc_add_si: 3+(-1) should be 2\n");
exit (1);
}
mpc_mul_2exp (z, z, (unsigned long int) prec, MPC_RNDNN);
if (mpc_add_si (z, z, s, MPC_RNDNN) == 0) {
printf ("Error in mpc_add_si: 2^(prec+1)-1 cannot be exact\n");
exit (1);
}
}
mpc_clear (z);
}
/* R_mpc_cmp - Comparison function for MPC objects.
*
* Ops.mpc.R includes code to coerce complex numbers or numerics from
* e2 into MPC objects for this comparison since the MPC library only
* supports comparison against other MPC objects or integers.
*
* Arguments:
* e1: SEXP for an mpc type.
* e2: SEXP for an mpc type, or integer.
* Return value:
* True if e1 == e2.
*/
SEXP R_mpc_cmp(SEXP e1, SEXP e2) {
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
return(Rf_ScalarInteger(mpc_cmp(*z1, *z2)));
} else if (Rf_isInteger(e2)) {
return(Rf_ScalarInteger(mpc_cmp_si(*z1,
INTEGER(e2)[0])));
} else {
Rf_error("Invalid operand for mpc cmp.");
}
} else {
Rf_error("Invalid operand for mpc cmp.");
}
}
