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]

Re: [patch,fortran] Fix PR19310 unnecessary error for overflowing results


:REVIEWMAIL:

Paul Brook wrote:
On Saturday 10 June 2006 21:30, Jerry DeLisle wrote:

+       if (mpfr_sgn (f) < 0)
+       real.sign = 1;


I think REAL_VALUE_TYPE is supposed to be an opaque type. Use REAL_VALUE_NEGATE here.



I have not found a REAL_VALUE_NEGATE in real.h or real.c It gave an error when I tried it.

*************** gfc_range_check (gfc_expr * e)
*** 555,560 ****
--- 555,563 ----
 {
   arith rc;

+   if (gfc_option.flag_range_check == 0)
+     return ARITH_OK;
+


This makes me nervous. I'd expect overflowed values to be set to +-Inf, like for we set underflowed values to zero.


At this point mpfr has already set the values to +-Inf or NaN when doing the computations in simplify.c. Before this patch we trapped those out and never did the computation and just did an error. mpfr also correctly handles underflow cases and sets the value to zero. I believe gfc_conv_mpfr_to_tree converts the zero values fine. gfc_conv_mpfr_to_tree did not handle NaN or +-Inf at all before because it did not need to. I have also tested the underflow case with 1/exp(1000) and get zeros out to 45 decimal places. I have added this to the test case

 /* 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.  */


This commentary should go in/above gfc_range_check.



OK, will do comment.


 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))


This is unnecessary because you already made gfc_range_check return ARITH_OK.

Ooops, You are right, I missed that. Will fix.


Updated ChangeLog below. Regtested OK. Revised patch and test case attached.

With above corrections, OK?

Jerry

2006-06-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR fortran/19310
	* arith.c (gfc_range_check): Return ARITH_OK if -fno-range-check.
	(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.

Attachment: real_const_3.f90
Description: application/extension-f90

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: ChangeLog
===================================================================
*** ChangeLog	(revision 114499)
--- ChangeLog	(working copy)
***************
*** 1,3 ****
--- 1,18 ----
+ 2006-06-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+ 
+ 	PR fortran/19310
+ 	* arith.c (gfc_range_check): Return ARITH_OK if -fno-range-check.
+ 	(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-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
  
  	PR fortran/27958
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_arith_neqv (gfc_expr * op1, gfc_expr
*** 548,560 ****
  
  /* 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)
  {
    arith rc;
  
    switch (e->ts.type)
      {
      case BT_INTEGER:
--- 548,564 ----
  
  /* 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)
  {
    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;
--- 817,824 ----
        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;
--- 829,837 ----
        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,119 ----
  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;
! 
!       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;
  }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]