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."); } }