From 545548257d8ad0c0663f70c61a1fd189eaf896b8 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 18 Jun 2006 06:36:45 +0000 Subject: re PR fortran/19310 ([4.1 Only] unnecessary error for overflowing results) 2006-06-18 Jerry DeLisle PR fortran/19310 * arith.c (gfc_range_check): Return ARITH_OK if -fno-range-check. Add return of ARITH_NAN, ARITH_UNDERFLOW, and ARITH_OVERFLOW. (gfc_arith_divide): If -fno-range-check allow mpfr to divide by zero. * gfortran.h (gfc_option_t): Add new flag. * invoke.texi: Document new flag. * lang.opt: Add option -frange-check. * options.c (gfc_init_options): Initialize new flag. (gfc_handle_options): Set flag if invoked. * simplify.c (range_check): Add error messages for overflow, underflow, and other errors. * trans-const.c (gfc_conv_mpfr_to_tree): Build NaN and Inf from mpfr result. From-SVN: r114752 --- gcc/fortran/trans-const.c | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-const.c') diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 936dd64..c1c9661 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -209,11 +209,31 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind) mp_exp_t exp; char *p, *q; int n; + REAL_VALUE_TYPE real; n = gfc_validate_kind (BT_REAL, kind, false); gcc_assert (gfc_real_kinds[n].radix == 2); + type = gfc_get_real_type (kind); + + /* Take care of Infinity and NaN. */ + if (mpfr_inf_p (f)) + { + real_inf (&real); + if (mpfr_sgn (f) < 0) + real = REAL_VALUE_NEGATE(real); + res = build_real (type , real); + return res; + } + + if (mpfr_nan_p (f)) + { + real_nan (&real, "", 0, TYPE_MODE (type)); + res = build_real (type , real); + return res; + } + /* mpfr chooses too small a number of hexadecimal digits if the number of binary digits is not divisible by four, therefore we have to explicitly request a sufficient number of digits here. */ @@ -234,7 +254,6 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind) else sprintf (q, "0x.%sp%d", p, (int) exp); - type = gfc_get_real_type (kind); res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type))); gfc_free (q); -- cgit v1.1