[PATCH] PR fortran/42651 -- Fix accepts-invalid

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

The attached patch fixes an accepts-invalid while enforcing

  C1560 (R1530) If RESULT appears, the function-name shall not appear
  in any specification statement in the scoping unit of the function
  subprogram.

Regression tested on x86_64-*-freebsd.  OK to commit?

2018-03-19  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/42651
	* decl.c (check_function_name): Improved error message
	(gfc_match_volatile, gfc_match_asynchronous) Use check_function_name.

2018-03-19  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/42651
	* gfortran.dg/pr42651.f90: New test.
	* gfortran.df/func_result_7.f90: Update for new error message.
-- 
Steve

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 258646)
+++ gcc/fortran/decl.c	(working copy)
@@ -2242,7 +2242,9 @@ check_function_name (char *name)
 	  && strcmp (block->result->name, "ppr@") != 0
 	  && strcmp (block->name, name) == 0)
 	{
-	  gfc_error ("Function name %qs not allowed at %C", name);
+	  gfc_error ("RESULT variable %qs at %L prohibits FUNCTION name %qs at %C "
+		     "from appearing in a specification statement",
+		     block->result->name, &block->result->declared_at, name);
 	  return false;
 	}
     }
@@ -9091,6 +9093,7 @@ match
 gfc_match_volatile (void)
 {
   gfc_symbol *sym;
+  char *name;
   match m;
 
   if (!gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C"))
@@ -9112,6 +9115,10 @@ gfc_match_volatile (void)
       switch (m)
 	{
 	case MATCH_YES:
+	  name = XCNEWVAR (char, strlen (sym->name) + 1);
+	  strcpy (name, sym->name);
+	  if (!check_function_name (name))
+	    return MATCH_ERROR;
 	  /* F2008, C560+C561. VOLATILE for host-/use-associated variable or
 	     for variable in a BLOCK which is defined outside of the BLOCK.  */
 	  if (sym->ns != gfc_current_ns && sym->attr.codimension)
@@ -9150,6 +9157,7 @@ match
 gfc_match_asynchronous (void)
 {
   gfc_symbol *sym;
+  char *name;
   match m;
 
   if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C"))
@@ -9171,6 +9179,10 @@ gfc_match_asynchronous (void)
       switch (m)
 	{
 	case MATCH_YES:
+	  name = XCNEWVAR (char, strlen (sym->name) + 1);
+	  strcpy (name, sym->name);
+	  if (!check_function_name (name))
+	    return MATCH_ERROR;
 	  if (!gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus))
 	    return MATCH_ERROR;
 	  goto next_item;
Index: gcc/testsuite/gfortran.dg/pr42651.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr42651.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr42651.f90	(working copy)
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR fortran/42651
+integer function func()
+  asynchronous :: func
+  integer, asynchronous:: b
+  allocatable :: c
+  volatile :: func
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+end function func
+
+function func2() result(res) ! { dg-error " RESULT variable" }
+  volatile res
+  asynchronous res
+  target func2            ! { dg-error " RESULT variable" }
+  volatile func2          ! { dg-error " RESULT variable" }
+  asynchronous func2      ! { dg-error " RESULT variable" }
+  allocatable func2       ! { dg-error " RESULT variable" }
+  dimension func2(2)      ! { dg-error " RESULT variable" }
+  codimension func2[*]    ! { dg-error " RESULT variable" }
+  contiguous func2        ! { dg-error " RESULT variable" }
+end function func2 
Index: gcc/testsuite/gfortran.dg/func_result_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/func_result_7.f90	(revision 258646)
+++ gcc/testsuite/gfortran.dg/func_result_7.f90	(working copy)
@@ -4,8 +4,8 @@
 !
 ! Contributed by Vittorio Zecca <zeccav@gmail.com>
 
-function fun() result(f)
-  pointer fun       ! { dg-error "not allowed" }
-  dimension fun(1)  ! { dg-error "not allowed" }
+function fun() result(f)  ! { dg-error "RESULT variable" } 
+  pointer fun             ! { dg-error "RESULT variable" }
+  dimension fun(1)        ! { dg-error "RESULT variable" }
   f=0
 end