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 <ka...@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 <ka...@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 <zec...@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
