diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/fortran/arith.c | 64 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 11 | ||||
| -rw-r--r-- | gcc/fortran/lang.opt | 4 | ||||
| -rw-r--r-- | gcc/fortran/options.c | 5 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 25 | ||||
| -rw-r--r-- | gcc/fortran/trans-const.c | 21 |
8 files changed, 127 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dac857a..0f35d86 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2006-06-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + 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. + 2006-06-17 Karl Berry <karl@gnu.org> * gfortran.texi (@dircategory): Use "Software development" 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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6cfd934..834d23f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1627,6 +1627,7 @@ typedef struct int flag_max_stack_var_size; int flag_module_access_private; int flag_no_backend; + int flag_range_check; int flag_pack_derived; int flag_repack_arrays; int flag_preprocessed; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index aa646c4..7b8036c 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -122,7 +122,7 @@ by type. Explanations are in the following sections. -ffixed-line-length-@var{n} -ffixed-line-length-none @gol -ffree-line-length-@var{n} -ffree-line-length-none @gol -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol --fcray-pointer -fopenmp } +-fcray-pointer -fopenmp -frange-check } @item Warning Options @xref{Warning Options,,Options to Request or Suppress Warnings}. @@ -308,6 +308,15 @@ and @code{c$}, @code{*$} and @code{!$} sentinels in fixed form and when linking arranges for the OpenMP runtime library to be linked in. +@cindex -frange-check +@cindex options, -frange-check +@item -frange-check +Enable range checking on results of simplification of constant expressions +during compilation. For example, by default, @command{gfortran} will give +an overflow error at compile time when simplifying @code{a = EXP(1000)}. +With @samp{-fno-range-check}, no error will be given and the variable @code{a} +will be assigned the value @code{+Infinity}. + @cindex -std=@var{std} option @cindex option, -std=@var{std} @item -std=@var{std} diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 439eb02..2857ec8 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -181,6 +181,10 @@ fno-backend Fortran RejectNegative Don't generate code, just do syntax and semantics checking +frange-check +Fortran +Enable range checking during compilation + fpack-derived Fortran Try to layout derived types as compact as possible diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 6add2b8..cd550d4 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -73,6 +73,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.flag_max_stack_var_size = 32768; gfc_option.flag_module_access_private = 0; gfc_option.flag_no_backend = 0; + gfc_option.flag_range_check = 1; gfc_option.flag_pack_derived = 0; gfc_option.flag_repack_arrays = 0; gfc_option.flag_preprocessed = 0; @@ -519,6 +520,10 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.flag_no_backend = value; break; + case OPT_frange_check: + gfc_option.flag_range_check = value; + break; + case OPT_fpack_derived: gfc_option.flag_pack_derived = value; break; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index b40d026..f8bf372 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -95,10 +95,29 @@ static int xascii_table[256]; static gfc_expr * range_check (gfc_expr * result, const char *name) { - if (gfc_range_check (result) == ARITH_OK) - return result; - gfc_error ("Result of %s overflows its kind at %L", name, &result->where); + switch (gfc_range_check (result)) + { + case ARITH_OK: + return result; + + case ARITH_OVERFLOW: + gfc_error ("Result of %s overflows its kind at %L", name, &result->where); + break; + + case ARITH_UNDERFLOW: + gfc_error ("Result of %s underflows its kind at %L", name, &result->where); + break; + + case ARITH_NAN: + gfc_error ("Result of %s is NaN at %L", name, &result->where); + break; + + default: + gfc_error ("Result of %s gives range error for its kind at %L", name, &result->where); + break; + } + gfc_free_expr (result); return &gfc_bad_expr; } 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); |