[fortran,patch] Allow some IEEE functions in constant and specification expressions

[fortran,patch] Allow some IEEE functions in constant and specification expressions

[FX]

[-- Attachment #1: Type: text/plain, Size: 1300 bytes --]

The attached patch fixes the only remaining IEEE bug (to my knowledge) in gfortran.

A Fortran 2008 interpretation request was submitted two years ago about which of the IEEE functions were supposed to be used in constant and specification expressions. The interp, voted on by J3 in Nov 2014, made corrections to the standard (see my comment at https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64104#c3 for the detail of this). This front-end patch makes gfortran conforming with the standard.

There is a minor caveat: since support for various kinds (results of the IEEE_SELECTED_REAL_KIND, IEEE_SUPPORT_ROUNDING, IEEE_SUPPORT_FLAG and IEEE_SUPPORT_HALTING functions) are detected at runtime, we need in the future a mechanism to communication the support detected in libgfortran back to the front-end. The current approach does not do that, but instead assumes that if IEEE modules are present, support is enabled for all flags and rounding modes. This is true on the common platforms (x86 and x86_64), so I guess it’s good enough to enable it now. In the meantime, I’m thinking about how best to achieve the long-term goal (spec file? secret logical constants in the IEEE modules?) for the future.

Bootstrapped and regtested on x86_64-apple-darwin14. OK to commit to trunk?

FX





[-- Attachment #2: ieee.ChangeLog --]
[-- Type: application/octet-stream, Size: 690 bytes --]

2015-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/64104
	* expr.c (gfc_check_init_expr): Allow some IEEE functions in
	constant expressions.
	(external_spec_function): Allow some IEEE functions in specification
	expressions.
	* simplify.c (gfc_simplify_ieee_selected_real_kind): Remove.
	(simplify_ieee_selected_real_kind, simplify_ieee_support,
	matches_ieee_function_name, gfc_simplify_ieee_functions): New
	functions.
	* gfortran.h (gfc_simplify_ieee_selected_real_kind): Remove
	prototype.
	(gfc_simplify_ieee_functions): Add prototype.


2015-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/64104
	* gfortran.dg/ieee/ieee_8.f90: New test.


[-- Attachment #3: ieee.diff --]
[-- Type: application/octet-stream, Size: 10248 bytes --]

Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 226632)
+++ gcc/fortran/expr.c	(working copy)
@@ -2474,13 +2474,14 @@ gfc_check_init_expr (gfc_expr *e)
 	gfc_intrinsic_sym* isym;
 	gfc_symbol* sym = e->symtree->n.sym;
 
-	/* Special case for IEEE_SELECTED_REAL_KIND from the intrinsic
-	   module IEEE_ARITHMETIC, which is allowed in initialization
-	   expressions.  */
-	if (!strcmp(sym->name, "ieee_selected_real_kind")
-	    && sym->from_intmod == INTMOD_IEEE_ARITHMETIC)
+	/* Simplify here the intrinsics from the IEEE_ARITHMETIC and
+	   IEEE_EXCEPTIONS modules.  */
+	int mod = sym->from_intmod;
+	if (mod == INTMOD_NONE && sym->generic)
+	  mod = sym->generic->sym->from_intmod;
+	if (mod == INTMOD_IEEE_ARITHMETIC || mod == INTMOD_IEEE_EXCEPTIONS)
 	  {
-	    gfc_expr *new_expr = gfc_simplify_ieee_selected_real_kind (e);
+	    gfc_expr *new_expr = gfc_simplify_ieee_functions (e);
 	    if (new_expr)
 	      {
 		gfc_replace_expr (e, new_expr);
@@ -2738,6 +2739,29 @@ external_spec_function (gfc_expr *e)
 
   f = e->value.function.esym;
 
+  /* IEEE functions allowed are "a reference to a transformational function
+     from the intrinsic module IEEE_ARITHMETIC or IEEE_EXCEPTIONS", and
+     "inquiry function from the intrinsic modules IEEE_ARITHMETIC and
+     IEEE_EXCEPTIONS".  */
+  if (f->from_intmod == INTMOD_IEEE_ARITHMETIC
+      || f->from_intmod == INTMOD_IEEE_EXCEPTIONS)
+    {
+      if (!strcmp (f->name, "ieee_selected_real_kind")
+	  || !strcmp (f->name, "ieee_support_rounding")
+	  || !strcmp (f->name, "ieee_support_flag")
+	  || !strcmp (f->name, "ieee_support_halting")
+	  || !strcmp (f->name, "ieee_support_datatype")
+	  || !strcmp (f->name, "ieee_support_denormal")
+	  || !strcmp (f->name, "ieee_support_divide")
+	  || !strcmp (f->name, "ieee_support_inf")
+	  || !strcmp (f->name, "ieee_support_io")
+	  || !strcmp (f->name, "ieee_support_nan")
+	  || !strcmp (f->name, "ieee_support_sqrt")
+	  || !strcmp (f->name, "ieee_support_standard")
+	  || !strcmp (f->name, "ieee_support_underflow_control"))
+	goto function_allowed;
+    }
+
   if (f->attr.proc == PROC_ST_FUNCTION)
     {
       gfc_error ("Specification function %qs at %L cannot be a statement "
@@ -2766,6 +2790,7 @@ external_spec_function (gfc_expr *e)
       return false;
     }
 
+function_allowed:
   return restricted_args (e->value.function.actual);
 }
 
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 226632)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2881,8 +2881,6 @@ gfc_formal_arglist *gfc_sym_get_dummy_ar
 /* intrinsic.c -- true if working in an init-expr, false otherwise.  */
 extern bool gfc_init_expr_flag;
 
-gfc_expr *gfc_simplify_ieee_selected_real_kind (gfc_expr *);
-
 /* Given a symbol that we have decided is intrinsic, mark it as such
    by placing it into a special module that is otherwise impossible to
    read or write.  */
@@ -3245,6 +3243,7 @@ int gfc_code_walker (gfc_code **, walk_c
 /* simplify.c */
 
 void gfc_convert_mpz_to_signed (mpz_t, int);
+gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 
 /* trans-array.c  */
 
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 226632)
+++ gcc/fortran/simplify.c	(working copy)
@@ -5553,20 +5553,6 @@ gfc_simplify_selected_real_kind (gfc_exp
 
 
 gfc_expr *
-gfc_simplify_ieee_selected_real_kind (gfc_expr *expr)
-{
-  gfc_actual_arglist *arg = expr->value.function.actual;
-  gfc_expr *p = arg->expr, *q = arg->next->expr,
-	   *rdx = arg->next->next->expr;
-
-  /* Currently, if IEEE is supported and this module is built, it means
-     all our floating-point types conform to IEEE. Hence, we simply handle
-     IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND.  */
-  return gfc_simplify_selected_real_kind (p, q, rdx);
-}
-
-
-gfc_expr *
 gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i)
 {
   gfc_expr *result;
@@ -6955,3 +6941,62 @@ gfc_simplify_compiler_version (void)
   return gfc_get_character_expr (gfc_default_character_kind,
                                 &gfc_current_locus, buffer, len);
 }
+
+/* Simplification routines for intrinsics of IEEE modules.  */
+
+gfc_expr *
+simplify_ieee_selected_real_kind (gfc_expr *expr)
+{
+  gfc_actual_arglist *arg = expr->value.function.actual;
+  gfc_expr *p = arg->expr, *q = arg->next->expr,
+	   *rdx = arg->next->next->expr;
+
+  /* Currently, if IEEE is supported and this module is built, it means
+     all our floating-point types conform to IEEE. Hence, we simply handle
+     IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND.  */
+  return gfc_simplify_selected_real_kind (p, q, rdx);
+}
+
+gfc_expr *
+simplify_ieee_support (gfc_expr *expr)
+{
+  /* We consider that if the IEEE modules are loaded, we have full support
+     for flags, halting and rounding, which are the three functions
+     (IEEE_SUPPORT_{FLAG,HALTING,ROUNDING}) allowed in constant
+     expressions. One day, we will need libgfortran to detect support and
+     communicate it back to us, allowing for partial support.  */
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &expr->where,
+			       true);
+}
+
+bool
+matches_ieee_function_name (gfc_symbol *sym, const char *name)
+{
+  int n = strlen(name);
+
+  if (!strncmp(sym->name, name, n))
+    return true;
+
+  /* If a generic was used and renamed, we need more work to find out.
+     Compare the specific name.  */
+  if (sym->generic && !strncmp(sym->generic->sym->name, name, n))
+    return true;
+
+  return false;
+}
+
+gfc_expr *
+gfc_simplify_ieee_functions (gfc_expr *expr)
+{
+  gfc_symbol* sym = expr->symtree->n.sym;
+
+  if (matches_ieee_function_name(sym, "ieee_selected_real_kind"))
+    return simplify_ieee_selected_real_kind (expr);
+  else if (matches_ieee_function_name(sym, "ieee_support_flag")
+	   || matches_ieee_function_name(sym, "ieee_support_halting")
+	   || matches_ieee_function_name(sym, "ieee_support_rounding"))
+    return simplify_ieee_support (expr);
+  else
+    return NULL;
+}
Index: gcc/testsuite/gfortran.dg/ieee/ieee_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/ieee_8.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/ieee/ieee_8.f90	(working copy)
@@ -0,0 +1,114 @@
+! { dg-do run }
+
+module foo
+  use :: ieee_exceptions
+  use :: ieee_arithmetic
+end module foo
+
+module bar
+  use foo
+  use :: ieee_arithmetic, yyy => ieee_support_rounding
+  use :: ieee_arithmetic, zzz => ieee_selected_real_kind
+end module
+
+program test
+  use :: bar
+  use :: ieee_arithmetic, xxx => ieee_support_rounding
+  implicit none
+
+  ! IEEE functions allowed in constant expressions
+
+  integer, parameter :: n1 = ieee_selected_real_kind(0, 0)
+  logical, parameter :: l1 = ieee_support_halting(ieee_overflow)
+  logical, parameter :: l2 = ieee_support_flag(ieee_overflow)
+  logical, parameter :: l3 = ieee_support_flag(ieee_overflow, 0.)
+  logical, parameter :: l4 = ieee_support_rounding(ieee_to_zero)
+  logical, parameter :: l5 = ieee_support_rounding(ieee_to_zero, 0.d0)
+
+  logical, parameter :: l6 = xxx(ieee_to_zero, 0.d0)
+  logical, parameter :: l7 = yyy(ieee_to_zero, 0.d0)
+  integer, parameter :: n2 = zzz(0, 0)
+
+  call gee(8, ieee_to_zero, ieee_overflow)
+
+end
+
+! IEEE functions allowed in specification expressions
+
+subroutine gee(n, rounding, flag)
+  use :: bar
+  implicit none
+
+  integer :: n
+  type(ieee_round_type) :: rounding
+  type(ieee_flag_type) :: flag
+
+  character(len=ieee_selected_real_kind(n)) :: s1
+  character(len=ieee_selected_real_kind(n,2*n)) :: s2
+  character(len=ieee_selected_real_kind(n,2*n,2)) :: s3
+
+  character(len=merge(4,2,ieee_support_rounding(rounding))) :: s4
+  character(len=merge(4,2,ieee_support_rounding(rounding, 0.d0))) :: s5
+
+  character(len=merge(4,2,ieee_support_flag(flag))) :: s6
+  character(len=merge(4,2,ieee_support_flag(flag, 0.))) :: s7
+
+  character(len=merge(4,2,ieee_support_halting(flag))) :: s8
+
+  character(len=merge(4,2,ieee_support_datatype())) :: s9
+  character(len=merge(4,2,ieee_support_datatype(0.))) :: s10
+
+  character(len=merge(4,2,ieee_support_denormal())) :: s11
+  character(len=merge(4,2,ieee_support_denormal(0.))) :: s12
+
+  character(len=merge(4,2,ieee_support_divide())) :: s13
+  character(len=merge(4,2,ieee_support_divide(0.))) :: s14
+
+  character(len=merge(4,2,ieee_support_inf())) :: s15
+  character(len=merge(4,2,ieee_support_inf(0.))) :: s16
+
+  character(len=merge(4,2,ieee_support_io())) :: s17
+  character(len=merge(4,2,ieee_support_io(0.))) :: s18
+
+  character(len=merge(4,2,ieee_support_nan())) :: s19
+  character(len=merge(4,2,ieee_support_nan(0.))) :: s20
+
+  character(len=merge(4,2,ieee_support_sqrt())) :: s21
+  character(len=merge(4,2,ieee_support_sqrt(0.))) :: s22
+
+  character(len=merge(4,2,ieee_support_standard())) :: s23
+  character(len=merge(4,2,ieee_support_standard(0.))) :: s24
+
+  character(len=merge(4,2,ieee_support_underflow_control())) :: s25
+  character(len=merge(4,2,ieee_support_underflow_control(0.))) :: s26
+
+  ! Now, check that runtime values match compile-time constants
+  ! (for those that are allowed)
+
+  integer, parameter :: x1 = ieee_selected_real_kind(8)
+  integer, parameter :: x2 = ieee_selected_real_kind(8,2*8)
+  integer, parameter :: x3 = ieee_selected_real_kind(8,2*8,2)
+
+  integer, parameter :: x4 = merge(4,2,ieee_support_rounding(rounding))
+  integer, parameter :: x5 = merge(4,2,ieee_support_rounding(rounding, 0.d0))
+
+  integer, parameter :: x6 = merge(4,2,ieee_support_flag(ieee_overflow))
+  integer, parameter :: x7 = merge(4,2,ieee_support_flag(ieee_overflow, 0.))
+
+  integer, parameter :: x8 = merge(4,2,ieee_support_halting(ieee_overflow))
+
+  if (len(s1) /= x1) call abort
+  if (len(s2) /= x2) call abort
+  if (len(s3) /= x3) call abort
+
+  if (len(s4) /= x4) call abort
+  if (len(s5) /= x5) call abort
+
+  if (len(s6) /= x6) call abort
+  if (len(s7) /= x7) call abort
+
+  if (len(s8) /= x8) call abort
+
+end subroutine
+
+! { dg-final { cleanup-modules "foo bar" } }

Re: [fortran,patch] Allow some IEEE functions in constant and specification expressions

[Paul Richard Thomas]

Hi FX,

This looks fine to me. OK for trunk.

I am not sure how you communicate the IEEE support to the front, since
you need to be able to support cross-compilation. I identification of
the hardware architecture sufficient?

Cheers

Paul

On 6 August 2015 at 18:11, FX <fxcoudert@gmail.com> wrote:
> The attached patch fixes the only remaining IEEE bug (to my knowledge) in gfortran.
>
> A Fortran 2008 interpretation request was submitted two years ago about which of the IEEE functions were supposed to be used in constant and specification expressions. The interp, voted on by J3 in Nov 2014, made corrections to the standard (see my comment at https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64104#c3 for the detail of this). This front-end patch makes gfortran conforming with the standard.
>
> There is a minor caveat: since support for various kinds (results of the IEEE_SELECTED_REAL_KIND, IEEE_SUPPORT_ROUNDING, IEEE_SUPPORT_FLAG and IEEE_SUPPORT_HALTING functions) are detected at runtime, we need in the future a mechanism to communication the support detected in libgfortran back to the front-end. The current approach does not do that, but instead assumes that if IEEE modules are present, support is enabled for all flags and rounding modes. This is true on the common platforms (x86 and x86_64), so I guess it’s good enough to enable it now. In the meantime, I’m thinking about how best to achieve the long-term goal (spec file? secret logical constants in the IEEE modules?) for the future.
>
> Bootstrapped and regtested on x86_64-apple-darwin14. OK to commit to trunk?
>
> FX
>
>
>
>



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Re: [fortran,patch] Allow some IEEE functions in constant and specification expressions

[FX]

> This looks fine to me. OK for trunk.

Thanks for review. Committed as revision 226723.


> I am not sure how you communicate the IEEE support to the front, since
> you need to be able to support cross-compilation. I identification of
> the hardware architecture sufficient?

Indeed, it is tricky to achieve, because identification of the target triplet is not sufficient. We need to test some functions/macros too.

FX