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

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

ping

-- 
steve

On Mon, Mar 19, 2018 at 06:13:58PM -0700, Steve Kargl wrote:
> 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


-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow