コード例 #1
0
ファイル: mpc_proj.c プロジェクト: rforge/mpc
SEXP R_mpc_imag(SEXP e1) {
	if (Rf_inherits(e1, "mpc")) {
		mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
		if (mpfr_fits_sint_p(mpc_imagref(*z1), GMP_RNDN)) {
			return Rf_ScalarReal(mpfr_get_d(mpc_imagref(*z1),
				GMP_RNDN));
		} else {
			Rf_error("Imaginary part doesn't fit in numeric.");
		}
	} else {
		Rf_error("Invalid operand for MPC log.");
	}
	return R_NilValue;	/* Not reached */
}
コード例 #2
0
ファイル: mpc_proj.c プロジェクト: rforge/mpc
SEXP R_mpc_arg(SEXP e1) {
	mpfr_t x;
	if (Rf_inherits(e1, "mpc")) {
		mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
		mpc_arg(x, *z1, GMP_RNDN);
		if (mpfr_fits_sint_p(x, GMP_RNDN)) {
			return Rf_ScalarReal(mpfr_get_d(x, GMP_RNDN));
		} else {
			Rf_error("Arg doesn't fit in numeric.");
		}
	} else {
		Rf_error("Invalid operand for MPC log.");
	}
	return R_NilValue;	/* Not reached */
}
コード例 #3
0
/* Convert R "mpfr" object (list of "mpfr1")  to R "integer" vector : */
SEXP mpfr2i(SEXP x, SEXP rnd_mode) {
    int n = length(x), i;
    SEXP val = PROTECT(allocVector(INTSXP, n));
    int *r = INTEGER(val);
    mpfr_t R_i;
    mpfr_init(R_i); /* with default precision */

    for(i=0; i < n; i++) {
	R_asMPFR(VECTOR_ELT(x, i), R_i);
	if(!mpfr_fits_sint_p(R_i, R_rnd2MP(rnd_mode))) {
	    warning("NAs introduced by coercion from \"mpfr\" [%d]", i+1);
	    r[i] = NA_INTEGER;
	}
	else {
	    long lr = mpfr_get_si(R_i, R_rnd2MP(rnd_mode));
	    r[i] = (int) lr;
	}
    }
    mpfr_clear (R_i);
    mpfr_free_cache();
    UNPROTECT(1);
    return val;
}
コード例 #4
0
ファイル: tfits.c プロジェクト: Scorpiion/Renux_cross_gcc
int
main (void)
{
  mpfr_t x;

  tests_start_mpfr ();

  mpfr_init2 (x, 256);

  /* Check NAN */
  mpfr_set_nan(x);
  if (mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR1;

  /* Check INF */
  mpfr_set_inf(x, 1);
  if (mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR1;

  /* Check Zero */
  MPFR_SET_ZERO(x);
  if (!mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;

  /* Check small op */
  mpfr_set_str1 (x, "1@-1");
  if (!mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;

  /* Check 17 */
  mpfr_set_ui (x, 17, GMP_RNDN);
  if (!mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;

  /* Check all other values */
  mpfr_set_ui(x, ULONG_MAX, GMP_RNDN);
  mpfr_mul_2exp(x, x, 1, GMP_RNDN);
  if (mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR1;
  mpfr_mul_2exp(x, x, 40, GMP_RNDN);
  if (mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR1;

  mpfr_set_ui(x, ULONG_MAX, GMP_RNDN);
  if (!mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR2;
  mpfr_set_ui(x, LONG_MAX, GMP_RNDN);
  if (!mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR2;
  mpfr_set_ui(x, UINT_MAX, GMP_RNDN);
  if (!mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR2;
  mpfr_set_ui(x, INT_MAX, GMP_RNDN);
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  mpfr_set_ui(x, USHRT_MAX, GMP_RNDN);
  if (!mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR2;
  mpfr_set_ui(x, SHRT_MAX, GMP_RNDN);
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;

  mpfr_set_si(x, 1, GMP_RNDN);
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;

  /* Check negative value */
  mpfr_set_si (x, -1, GMP_RNDN);
  if (!mpfr_fits_sint_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_sshort_p(x, GMP_RNDN))
    ERROR2;
  if (!mpfr_fits_slong_p(x, GMP_RNDN))
    ERROR2;
  if (mpfr_fits_uint_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_ushort_p(x, GMP_RNDN))
    ERROR1;
  if (mpfr_fits_ulong_p(x, GMP_RNDN))
    ERROR1;

  mpfr_clear (x);

  check_intmax ();

  tests_end_mpfr ();
  return 0;
}
コード例 #5
0
ファイル: tfits.c プロジェクト: epowers/mpfr
int
main (void)
{
  mpfr_t x, y;
  int i, r;

  tests_start_mpfr ();

  mpfr_init2 (x, 256);
  mpfr_init2 (y, 8);

  RND_LOOP (r)
    {

      /* Check NAN */
      mpfr_set_nan (x);
      if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (1);
      if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (2);
      if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (3);
      if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (4);
      if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (5);
      if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (6);

      /* Check INF */
      mpfr_set_inf (x, 1);
      if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (7);
      if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (8);
      if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (9);
      if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (10);
      if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (11);
      if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (12);

      /* Check Zero */
      MPFR_SET_ZERO (x);
      if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (13);
      if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (14);
      if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (15);
      if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (16);
      if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (17);
      if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (18);

      /* Check small positive op */
      mpfr_set_str1 (x, "1@-1");
      if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (19);
      if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (20);
      if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (21);
      if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (22);
      if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (23);
      if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (24);

      /* Check 17 */
      mpfr_set_ui (x, 17, MPFR_RNDN);
      if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (25);
      if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (26);
      if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (27);
      if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (28);
      if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (29);
      if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (30);

      /* Check all other values */
      mpfr_set_ui (x, ULONG_MAX, MPFR_RNDN);
      mpfr_mul_2exp (x, x, 1, MPFR_RNDN);
      if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (31);
      if (mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (32);
      mpfr_mul_2exp (x, x, 40, MPFR_RNDN);
      if (mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (33);
      if (mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (34);
      if (mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (35);
      if (mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (36);
      if (mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (37);

      mpfr_set_ui (x, ULONG_MAX, MPFR_RNDN);
      if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r))
        ERROR1 (38);
      mpfr_set_ui (x, LONG_MAX, MPFR_RNDN);
      if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
        ERROR1 (39);
      mpfr_set_ui (x, UINT_MAX, MPFR_RNDN);
      if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r))
        ERROR1 (40);
      mpfr_set_ui (x, INT_MAX, MPFR_RNDN);
      if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (41);
      mpfr_set_ui (x, USHRT_MAX, MPFR_RNDN);
      if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r))
        ERROR1 (42);
      mpfr_set_ui (x, SHRT_MAX, MPFR_RNDN);
      if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (43);

      mpfr_set_si (x, 1, MPFR_RNDN);
      if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
        ERROR1 (44);
      if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
        ERROR1 (45);

      /* Check negative op */
      for (i = 1; i <= 4; i++)
        {
          int inv;

          mpfr_set_si_2exp (x, -i, -2, MPFR_RNDN);
          mpfr_rint (y, x, (mpfr_rnd_t) r);
          inv = MPFR_NOTZERO (y);
          if (!mpfr_fits_ulong_p (x, (mpfr_rnd_t) r) ^ inv)
            ERROR1 (46);
          if (!mpfr_fits_slong_p (x, (mpfr_rnd_t) r))
            ERROR1 (47);
          if (!mpfr_fits_uint_p (x, (mpfr_rnd_t) r) ^ inv)
            ERROR1 (48);
          if (!mpfr_fits_sint_p (x, (mpfr_rnd_t) r))
            ERROR1 (49);
          if (!mpfr_fits_ushort_p (x, (mpfr_rnd_t) r) ^ inv)
            ERROR1 (50);
          if (!mpfr_fits_sshort_p (x, (mpfr_rnd_t) r))
            ERROR1 (51);
        }
    }

  mpfr_clear (x);
  mpfr_clear (y);

  check_intmax ();

  tests_end_mpfr ();
  return 0;
}