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.

	* gfortran.dg/ieee/ieee_8.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@226723 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 31 insertions, 6 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 9e5a804f70dc..1d6f310f28ca 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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);
 }