This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [patch,fortran] Fix PR19310 unnecessary error for overflowing results
:REVIEWMAIL:
The attached patch expands considerably on the last one.
I think I have covered all possibilities in the correct order.
This is a request for further comment.
It occurred to me that in simplify.c there are many functions with their own
error checking independent of range_check. Do we want to incorporate the
-frange_check flag into these error checks?
Also I noticed that IFORT does not do all this checking by default and happily
compiles a lot of stuff. We could default this the other way. Any thoughts on
that? (not that intel is the only way to do this)
Regardless, the patch regtests OK, including the test case I submitted earlier.
If no further comments is this OK to commit?
Regards,
Jerry
Index: gfortran.h
===================================================================
*** gfortran.h (revision 114499)
--- gfortran.h (working copy)
*************** typedef struct
*** 1627,1632 ****
--- 1627,1633 ----
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;
Index: lang.opt
===================================================================
*** lang.opt (revision 114499)
--- lang.opt (working copy)
*************** fno-backend
*** 181,186 ****
--- 181,190 ----
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
Index: trans-const.c
===================================================================
*** trans-const.c (revision 114499)
--- trans-const.c (working copy)
*************** gfc_conv_mpfr_to_tree (mpfr_t f, int kin
*** 209,219 ****
--- 209,239 ----
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. */
*************** gfc_conv_mpfr_to_tree (mpfr_t f, int kin
*** 234,240 ****
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);
--- 254,259 ----
Index: invoke.texi
===================================================================
*** invoke.texi (revision 114499)
--- invoke.texi (working copy)
*************** by type. Explanations are in the follow
*** 122,128 ****
-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 }
@item Warning Options
@xref{Warning Options,,Options to Request or Suppress Warnings}.
--- 122,128 ----
-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 -frange-check }
@item Warning Options
@xref{Warning Options,,Options to Request or Suppress Warnings}.
*************** and @code{c$}, @code{*$} and @code{!$} s
*** 308,313 ****
--- 308,322 ----
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}
Index: arith.c
===================================================================
*** arith.c (revision 114499)
--- arith.c (working copy)
*************** gfc_check_real_range (mpfr_t p, int kind
*** 379,390 ****
mpfr_init (q);
mpfr_abs (q, p, GFC_RND_MODE);
! if (mpfr_sgn (q) == 0)
retval = ARITH_OK;
else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
! retval = ARITH_OVERFLOW;
else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0)
! 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
--- 379,414 ----
mpfr_init (q);
mpfr_abs (q, p, GFC_RND_MODE);
! 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)
! {
! 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)
! {
! 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
*************** gfc_arith_neqv (gfc_expr * op1, gfc_expr
*** 548,554 ****
/* Make sure a constant numeric expression is within the range for
its type and kind. Note that there's also a gfc_check_range(),
! but that one deals with the intrinsic RANGE function. */
arith
gfc_range_check (gfc_expr * e)
--- 572,579 ----
/* Make sure a constant numeric expression is within the range for
its type and kind. Note that there's also a gfc_check_range(),
! but that one deals with the intrinsic RANGE function. Just returns
! the result unchanged and ARITH_OK if -fno-range-check was given. */
arith
gfc_range_check (gfc_expr * e)
*************** gfc_range_check (gfc_expr * e)
*** 564,581 ****
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);
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);
}
break;
--- 589,618 ----
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);
! 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_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);
! 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);
! 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;
*************** gfc_arith_divide (gfc_expr * op1, gfc_ex
*** 813,820 ****
break;
case BT_REAL:
! /* FIXME: MPFR correctly generates NaN. This may not be needed. */
! if (mpfr_sgn (op2->value.real) == 0)
{
rc = ARITH_DIV0;
break;
--- 850,857 ----
break;
case BT_REAL:
! if (mpfr_sgn (op2->value.real) == 0
! && gfc_option.flag_range_check == 1)
{
rc = ARITH_DIV0;
break;
*************** gfc_arith_divide (gfc_expr * op1, gfc_ex
*** 825,833 ****
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)
{
rc = ARITH_DIV0;
break;
--- 862,870 ----
break;
case BT_COMPLEX:
if (mpfr_sgn (op2->value.complex.r) == 0
! && mpfr_sgn (op2->value.complex.i) == 0
! && gfc_option.flag_range_check == 1)
{
rc = ARITH_DIV0;
break;
Index: options.c
===================================================================
*** options.c (revision 114499)
--- options.c (working copy)
*************** gfc_init_options (unsigned int argc ATTR
*** 73,78 ****
--- 73,79 ----
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;
*************** gfc_handle_option (size_t scode, const c
*** 519,524 ****
--- 520,529 ----
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;
Index: simplify.c
===================================================================
*** simplify.c (revision 114499)
--- simplify.c (working copy)
*************** static int xascii_table[256];
*** 95,104 ****
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);
gfc_free_expr (result);
return &gfc_bad_expr;
}
--- 95,123 ----
static gfc_expr *
range_check (gfc_expr * result, const char *name)
{
! 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;
}