Re: [Patch, Fortran] PR45859 - Permit array elements to coarray dummy arguments

[Tobias Burnus <tobias.burnus@physik.fu-berlin.de>]

I pressed "Send" too early - as the testsuite fails unless the following
patch is applied. I think I will just use this test case (with patch)
instead of adding a new test-suite file. Required patch:

--- a/gcc/testsuite/gfortran.dg/coarray_args_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_args_2.f90
@@ -40,8 +40,7 @@ program rank_mismatch_02
   sync all

   call subr(ndim, a(1:1,2)) ! OK
-  call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" }
-                          ! See also F08/0048 and PR 45859 about the validity
+  call subr(ndim, a(1,2)) ! See also F08/0048 and PR 45859 about the validity
   if (this_image() == 1) then
      write(*, *) 'OK'
   end if


Tobias

On Fri, Dec 04, 2015 at 01:39:22PM +0100, Tobias Burnus wrote:
> This patch permits
> 
>    interface
>       subroutine sub (x)
>          real x(10)[*]
>       end subroutine
>    end interface
>    real :: x(100)[*]
>    call sub (x(10))
>    end
> 
> where one passes an array element ("x(10)") of a contiguous array to a
> coarray dummy argument. That's permitted per interpretation request
> F08/0048, which ended up in Fortran 2008's Corrigendum 2 - and is also
> in the current Fortran 2015 drafts:
> 
> "If the dummy argument is an array coarray that has the CONTIGUOUS attribute
>  or is not of assumed shape, the corresponding actual argument shall be
>  simply contiguous or an element of a simply contiguous array."
> 
> the "or ..." of the last line was added in the corrigendum.
> 
> 
> I hope and think that I got the true/false of the other users correct - in
> most cases, it probably doesn't matter as the caller is only reached for
> expr->rank > 0.
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
> 
> Tobias

> gcc/fortran
> 	PR fortran/45859
> 	* expr.c (gfc_is_simply_contiguous): Optionally permit array elements.
> 	(gfc_check_pointer_assign): Update call.
> 	* interface.c (compare_parameter): Ditto.
> 	* trans-array.c (gfc_conv_array_parameter): Ditto.
> 	* trans-intrinsic.c (gfc_conv_intrinsic_transfer,
> 	conv_isocbinding_function): Ditto.
> 	* gfortran.h (gfc_is_simply_contiguous):
> 
> gcc/testsuite/
> 	PR fortran/45859
> 	* gfortran.dg/coarray_argument_1.f90: New.
> 
> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
> index 2aeb0b5..5dd90ef 100644
> --- a/gcc/fortran/expr.c
> +++ b/gcc/fortran/expr.c
> @@ -3683,7 +3683,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
>  	 and F2008 must be allowed.  */
>        if (rvalue->rank != 1)
>  	{
> -	  if (!gfc_is_simply_contiguous (rvalue, true))
> +	  if (!gfc_is_simply_contiguous (rvalue, true, false))
>  	    {
>  	      gfc_error ("Rank remapping target must be rank 1 or"
>  			 " simply contiguous at %L", &rvalue->where);
> @@ -4601,7 +4601,7 @@ gfc_has_ultimate_pointer (gfc_expr *e)
>     a "(::1)" is accepted.  */
>  
>  bool
> -gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
> +gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
>  {
>    bool colon;
>    int i;
> @@ -4615,7 +4615,7 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
>    else if (expr->expr_type != EXPR_VARIABLE)
>      return false;
>  
> -  if (expr->rank == 0)
> +  if (!permit_element && expr->rank == 0)
>      return false;
>  
>    for (ref = expr->ref; ref; ref = ref->next)
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 9f61e45..d203c32 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -2982,7 +2982,7 @@ void gfc_free_actual_arglist (gfc_actual_arglist *);
>  gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
>  const char *gfc_extract_int (gfc_expr *, int *);
>  bool is_subref_array (gfc_expr *);
> -bool gfc_is_simply_contiguous (gfc_expr *, bool);
> +bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
>  bool gfc_check_init_expr (gfc_expr *);
>  
>  gfc_expr *gfc_build_conversion (gfc_expr *);
> diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
> index f74239d..bfd5d36 100644
> --- a/gcc/fortran/interface.c
> +++ b/gcc/fortran/interface.c
> @@ -2020,7 +2020,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
>  
>    /* F2008, C1241.  */
>    if (formal->attr.pointer && formal->attr.contiguous
> -      && !gfc_is_simply_contiguous (actual, true))
> +      && !gfc_is_simply_contiguous (actual, true, false))
>      {
>        if (where)
>  	gfc_error ("Actual argument to contiguous pointer dummy %qs at %L "
> @@ -2131,15 +2131,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
>  
>    if (formal->attr.codimension)
>      {
> -      /* F2008, 12.5.2.8.  */
> +      /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048).  */
> +      /* F2015, 12.5.2.8.  */
>        if (formal->attr.dimension
>  	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
>  	  && gfc_expr_attr (actual).dimension
> -	  && !gfc_is_simply_contiguous (actual, true))
> +	  && !gfc_is_simply_contiguous (actual, true, true))
>  	{
>  	  if (where)
>  	    gfc_error ("Actual argument to %qs at %L must be simply "
> -		       "contiguous", formal->name, &actual->where);
> +		       "contiguous or an element of such an array",
> +		       formal->name, &actual->where);
>  	  return 0;
>  	}
>  
> @@ -2179,7 +2181,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
>        && (actual->symtree->n.sym->attr.asynchronous
>           || actual->symtree->n.sym->attr.volatile_)
>        &&  (formal->attr.asynchronous || formal->attr.volatile_)
> -      && actual->rank && formal->as && !gfc_is_simply_contiguous (actual, true)
> +      && actual->rank && formal->as
> +      && !gfc_is_simply_contiguous (actual, true, false)
>        && ((formal->as->type != AS_ASSUMED_SHAPE
>  	   && formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer)
>  	  || formal->attr.contiguous))
> diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
> index 69f6e19..6e24e2e 100644
> --- a/gcc/fortran/trans-array.c
> +++ b/gcc/fortran/trans-array.c
> @@ -7386,7 +7386,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
>  		  && ref->u.ar.as->type != AS_ASSUMED_RANK
>  		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
>  		      ||
> -	     gfc_is_simply_contiguous (expr, false));
> +	     gfc_is_simply_contiguous (expr, false, true));
>  
>    no_pack = contiguous && no_pack;
>  
> @@ -7464,7 +7464,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
>      }
>  
>    if (g77 || (fsym && fsym->attr.contiguous
> -	      && !gfc_is_simply_contiguous (expr, false)))
> +	      && !gfc_is_simply_contiguous (expr, false, true)))
>      {
>        tree origptr = NULL_TREE;
>  
> diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
> index 21efe44..743148e 100644
> --- a/gcc/fortran/trans-intrinsic.c
> +++ b/gcc/fortran/trans-intrinsic.c
> @@ -6244,7 +6244,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
>        source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
>  
>        /* Repack the source if not simply contiguous.  */
> -      if (!gfc_is_simply_contiguous (arg->expr, false))
> +      if (!gfc_is_simply_contiguous (arg->expr, false, true))
>  	{
>  	  tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);
>  
> @@ -7142,7 +7142,7 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
>      {
>        if (arg->expr->rank == 0)
>  	gfc_conv_expr_reference (se, arg->expr);
> -      else if (gfc_is_simply_contiguous (arg->expr, false))
> +      else if (gfc_is_simply_contiguous (arg->expr, false, false))
>  	gfc_conv_array_parameter (se, arg->expr, true, NULL, NULL, NULL);
>        else
>  	{
> diff --git a/gcc/testsuite/gfortran.dg/coarray_argument_1.f90 b/gcc/testsuite/gfortran.dg/coarray_argument_1.f90
> new file mode 100644
> index 0000000..511da29
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/coarray_argument_1.f90
> @@ -0,0 +1,14 @@
> +! { dg-do compile }
> +! { dg-options "-fcoarray=lib" }
> +!
> +! PR fortran/45859
> +! Interpretation request F08/0048
> +!
> +   interface
> +      subroutine sub (x)
> +         real x(10)[*]
> +      end subroutine
> +   end interface
> +   real :: x(100)[*]
> +   call sub (x(10))
> +   end