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/arith.c | 64 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 49 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/arith.c') diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 348b87f..55289b4 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -379,12 +379,36 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); - if (mpfr_sgn (q) == 0) + if (mpfr_inf_p (p)) + { + if (gfc_option.flag_range_check == 0) + retval = ARITH_OK; + else + retval = ARITH_OVERFLOW; + } + else if (mpfr_nan_p (p)) + { + if (gfc_option.flag_range_check == 0) + retval = ARITH_OK; + else + retval = ARITH_NAN; + } + else if (mpfr_sgn (q) == 0) retval = ARITH_OK; else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) - retval = ARITH_OVERFLOW; + { + if (gfc_option.flag_range_check == 0) + retval = ARITH_OK; + else + retval = ARITH_OVERFLOW; + } else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0) - retval = ARITH_UNDERFLOW; + { + if (gfc_option.flag_range_check == 0) + retval = ARITH_OK; + else + retval = ARITH_UNDERFLOW; + } else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) { /* MPFR operates on a numbers with a given precision and enormous @@ -564,19 +588,29 @@ gfc_range_check (gfc_expr * e) case BT_REAL: rc = gfc_check_real_range (e->value.real, e->ts.kind); if (rc == ARITH_UNDERFLOW) - mpfr_set_ui (e->value.real, 0, GFC_RND_MODE); + mpfr_set_ui (e->value.real, 0, GFC_RND_MODE); + if (rc == ARITH_OVERFLOW) + mpfr_set_inf (e->value.real, mpfr_sgn (e->value.real)); + if (rc == ARITH_NAN) + mpfr_set_nan (e->value.real); break; case BT_COMPLEX: rc = gfc_check_real_range (e->value.complex.r, e->ts.kind); if (rc == ARITH_UNDERFLOW) - mpfr_set_ui (e->value.complex.r, 0, GFC_RND_MODE); - if (rc == ARITH_OK || rc == ARITH_UNDERFLOW) - { - rc = gfc_check_real_range (e->value.complex.i, e->ts.kind); - if (rc == ARITH_UNDERFLOW) - mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE); - } + mpfr_set_ui (e->value.complex.r, 0, GFC_RND_MODE); + if (rc == ARITH_OVERFLOW) + mpfr_set_inf (e->value.complex.r, mpfr_sgn (e->value.complex.r)); + if (rc == ARITH_NAN) + mpfr_set_nan (e->value.complex.r); + + rc = gfc_check_real_range (e->value.complex.i, e->ts.kind); + if (rc == ARITH_UNDERFLOW) + mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE); + if (rc == ARITH_OVERFLOW) + mpfr_set_inf (e->value.complex.i, mpfr_sgn (e->value.complex.i)); + if (rc == ARITH_NAN) + mpfr_set_nan (e->value.complex.i); break; @@ -813,8 +847,8 @@ gfc_arith_divide (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) break; case BT_REAL: - /* FIXME: MPFR correctly generates NaN. This may not be needed. */ - if (mpfr_sgn (op2->value.real) == 0) + if (mpfr_sgn (op2->value.real) == 0 + && gfc_option.flag_range_check == 1) { rc = ARITH_DIV0; break; @@ -825,9 +859,9 @@ gfc_arith_divide (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) break; case BT_COMPLEX: - /* FIXME: MPFR correctly generates NaN. This may not be needed. */ if (mpfr_sgn (op2->value.complex.r) == 0 - && mpfr_sgn (op2->value.complex.i) == 0) + && mpfr_sgn (op2->value.complex.i) == 0 + && gfc_option.flag_range_check == 1) { rc = ARITH_DIV0; break; -- cgit v1.1