[patch, fortran] PR29916 - Ping

[Paul Thomas]

Ping:

http://gcc.gnu.org/ml/fortran/2006-11/msg00576.html 

This rejects-valid fix was posted on 21st November.

Paul

Paul
> (now with attached patch)
>
> Jerry DeLisle wrote:
>   
>>> fortran/
>>> 2006-11-21  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>>     PR fortran/29916
>>>     * resolve.c (resolve_symbol): Allow host-associated variables
>>>       in the specification expression of an array-valued function.
>>>     * expr.c (check_restricted): Accept host-associated dummy
>>>       array indices.
>>>
>>> testsuite/
>>> 2006-11-21  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>>     PR fortran/29916
>>>     * gfortran.dg/host_dummy_index_1.f90: Added additional test.
>>>
>>>       
>> Tobias, I see no patch attached. :)
>>     
> Thanks for pointing out.
>
> Tobias
>   
> ------------------------------------------------------------------------
>
> Index: gcc/fortran/resolve.c
> ===================================================================
> *** gcc/fortran/resolve.c	(revision 118704)
> --- gcc/fortran/resolve.c	(working copy)
> *************** resolve_symbol (gfc_symbol * sym)
> *** 6016,6023 ****
> --- 6032,6048 ----
>        on COMMON blocks.  */
>   
>     check_constant = sym->attr.in_common && !sym->attr.pointer;
> + 
> +   /* Set the formal_arg_flag so that check_conflict will not throw
> +      an error for host associated variables in the specification
> +      expression for an array_valued function.  */
> +   if (sym->attr.function && sym->as)
> +     formal_arg_flag = 1;
> + 
>     gfc_resolve_array_spec (sym->as, check_constant);
>   
> +   formal_arg_flag = 0;
> + 
>     /* Resolve formal namespaces.  */
>   
>     if (formal_ns_flag && sym != NULL && sym->formal_ns != NULL)
> Index: gcc/fortran/expr.c
> ===================================================================
> *** gcc/fortran/expr.c	(revision 118704)
> --- gcc/fortran/expr.c	(working copy)
> *************** check_restricted (gfc_expr * e)
> *** 2046,2059 ****
>   
>         /* gfc_is_formal_arg broadcasts that a formal argument list is being processed
>   	 in resolve.c(resolve_formal_arglist).  This is done so that host associated
> ! 	 dummy array indices are accepted (PR23446).  */
>         if (sym->attr.in_common
>   	  || sym->attr.use_assoc
>   	  || sym->attr.dummy
>   	  || sym->ns != gfc_current_ns
>   	  || (sym->ns->proc_name != NULL
>   	      && sym->ns->proc_name->attr.flavor == FL_MODULE)
> ! 	  || gfc_is_formal_arg ())
>   	{
>   	  t = SUCCESS;
>   	  break;
> --- 2046,2060 ----
>   
>         /* gfc_is_formal_arg broadcasts that a formal argument list is being processed
>   	 in resolve.c(resolve_formal_arglist).  This is done so that host associated
> ! 	 dummy array indices are accepted (PR23446). This mechanism also does the
> ! 	 same for the specification expressions of array-valued functions.  */
>         if (sym->attr.in_common
>   	  || sym->attr.use_assoc
>   	  || sym->attr.dummy
>   	  || sym->ns != gfc_current_ns
>   	  || (sym->ns->proc_name != NULL
>   	      && sym->ns->proc_name->attr.flavor == FL_MODULE)
> ! 	  || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
>   	{
>   	  t = SUCCESS;
>   	  break;
> Index: gcc/testsuite/gfortran.dg/host_dummy_index_1.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/host_dummy_index_1.f90	(Revision 119028)
> +++ gcc/testsuite/gfortran.dg/host_dummy_index_1.f90	(Arbeitskopie)
> @@ -1,8 +1,10 @@
>  ! { dg-do run }
>  ! Tests the fix for PR23446. Based on PR example.
> -!
>  ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
>  !
> +! Tests furthermore the fix for PR fortran/29916.
> +! Test contributed by Marco Restelli <mrestelli@gmail.com>
> +!
>  PROGRAM TST
>    INTEGER IMAX
>    INTEGER :: A(4) = 1
> @@ -12,6 +14,7 @@
>    CALL T(A)
>    CALL U(A)
>    if ( ALL(A.ne.(/2,2,3,4/))) CALL ABORT ()
> +  if ( ALL(F().ne.(/2.0,2.0/))) CALL ABORT()
>  
>  CONTAINS
>    SUBROUTINE S(A)
> @@ -26,4 +29,8 @@
>      INTEGER A(2,IMAX)
>      A(2,2) = 4
>    END SUBROUTINE U
> +  FUNCTION F()
> +    real :: F(IMAX)
> +    F = 2.0
> +  END FUNCTION F
>  ENDPROGRAM TST
>