re PR fortran/42651 (Functions with result: Wrongly accepts attributes to function name)

2018-03-24  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-24  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/42651
	* gfortran.dg/pr42651.f90: New test.
	* gfortran.dg/func_result_7.f90: Update error message.

From-SVN: r258834

5 files changed, 52 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 64142c5..2cf32f3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2018-03-24  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-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/84922
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a826890..dce9dd2 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2253,7 +2253,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;
 	}
     }
@@ -9102,6 +9104,7 @@ match
 gfc_match_volatile (void)
 {
   gfc_symbol *sym;
+  char *name;
   match m;
 
   if (!gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C"))
@@ -9123,6 +9126,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)
@@ -9161,6 +9168,7 @@ match
 gfc_match_asynchronous (void)
 {
   gfc_symbol *sym;
+  char *name;
   match m;
 
   if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C"))
@@ -9182,6 +9190,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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1ea5f0c..962711c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-03-24  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/42651
+	* gfortran.dg/pr42651.f90: New test.
+	* gfortran.dg/func_result_7.f90: Update error message.
+
 2018-03-24  Richard Sandiford  <richard.sandiford@linaro.org>
 
 	PR tree-optimization/84005
diff --git a/gcc/testsuite/gfortran.dg/func_result_7.f90 b/gcc/testsuite/gfortran.dg/func_result_7.f90
index 9a982f1..027a978 100644
--- a/gcc/testsuite/gfortran.dg/func_result_7.f90
+++ b/gcc/testsuite/gfortran.dg/func_result_7.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/pr42651.f90 b/gcc/testsuite/gfortran.dg/pr42651.f90
new file mode 100644
index 0000000..f13a641
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42651.f90
@@ -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