From: Steven G. Kargl Date: Sat, 24 Mar 2018 16:31:57 +0000 (+0000) Subject: re PR fortran/42651 (Functions with result: Wrongly accepts attributes to function... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ba77f7bad0f0898454cdef193a24a825cbc3f953;p=gcc.git re PR fortran/42651 (Functions with result: Wrongly accepts attributes to function name) 2018-03-24 Steven G. Kargl 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 PR fortran/42651 * gfortran.dg/pr42651.f90: New test. * gfortran.dg/func_result_7.f90: Update error message. From-SVN: r258834 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 64142c54c21..2cf32f3a415 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-03-24 Steven G. Kargl + + 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 PR fortran/84922 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a82689069d4..dce9dd2d6df 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 1ea5f0cba47..962711c2868 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-03-24 Steven G. Kargl + + PR fortran/42651 + * gfortran.dg/pr42651.f90: New test. + * gfortran.dg/func_result_7.f90: Update error message. + 2018-03-24 Richard Sandiford 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 9a982f1e6fd..027a97878ba 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 -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 00000000000..f13a641b3b7 --- /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