This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
PR fortran/19310 PR fortran/19904 * 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): Return result if -frange-check not set. Add error messages for overflow, underflow, and other errors. * trans-const.c (gfc_conv_mpfr_to_tree): Build NaN and Inf.
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.sign = 1;
+ 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_range_check (gfc_expr * e)
*** 555,560 ****
--- 555,563 ----
{
arith rc;
+ if (gfc_option.flag_range_check == 0)
+ return ARITH_OK;
+
switch (e->ts.type)
{
case BT_INTEGER:
*************** 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;
--- 816,823 ----
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;
--- 828,836 ----
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];
*** 90,104 ****
/* Range checks an expression node. If all goes well, returns the
! node, otherwise returns &gfc_bad_expr and frees the node. */
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;
}
--- 90,122 ----
/* Range checks an expression node. If all goes well, returns the
! node, otherwise returns &gfc_bad_expr and frees the node. Just
! returns the result if -fno-range-check was given. */
static gfc_expr *
range_check (gfc_expr * result, const char *name)
{
! if (gfc_option.flag_range_check == 0)
return result;
! 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;
!
! 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;
}
Attachment:
real_const_3.f90
Description: application/extension-f90
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |