Re: [PATCH] fortran: [PR53800] Wrong copy-in/out with array actual to, TARGET dummy

Le 08/08/2026 à 21:31, Jerry D a écrit :
> See the attached patch. This is several iterations after Mikael's 
> comments which were very helpful. I took a different approach on the use 
> of macros and this addresses the non derived type examples Mikael 
> provided in the previous review.
> 
> I have added additional test cases.
> 
> Regression tested on x86_64.
> 
> OK for mainline?
> 
There is one important thing that I missed in the first review, it's 
that gfc_build_dummy_array_decl creates array declarations like:
     integer(kind=4)[0:D.4797] * a.0;
i.e. a pointer to an array.  For the target dummy arguments we are 
interested in with this patch, this is lying to the middle-end, as those 
arguments can only be used with span and pointer arithmetics.  I think 
the decl should be instead:
     integer(kind=4) * a.0;
i.e. the array type should be unwrapped.  But the easiest is probably to 
return early in gfc_build_dummy_array_decl and drop the variable decl 
completely. That's already what is done for pointers, classes, and a few 
others.  And then, all the GFC_DECL_SAVED_DESCRIPTOR business 
disappears, ...

> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index 47b28c1d003..621899b3dbe 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
> @@ -1408,6 +1408,11 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)>
>    GFC_DECL_SAVED_DESCRIPTOR (decl) = dummy;
>
> +  if (!is_classarray && sym->attr.target && !sym->attr.value
> +      && !sym->attr.contiguous && as->type == AS_ASSUMED_SHAPE
> +      && packed == PACKED_NO)
> +    GFC_DECL_PTR_ARRAY_P (decl) = 1;
> +
... and this needs to be moved ...
>    if (sym->ns->proc_name->backend_decl == current_function_decl
>        || sym->attr.contained)
>      gfc_add_decl_to_function (decl);


> @@ -1786,7 +1791,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
>  	  && sym->attr.allocatable)
>  	gfc_defer_symbol_init (sym);
>
> -      if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)> +      if (sym->attr.dimension && sym->ts.type != BT_CLASS
> +	  && (sym->attr.pointer
> +	      || (sym->attr.target && !sym->attr.contiguous
> +		  && sym->as && sym->as->type == AS_ASSUMED_RANK)))
>  	GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
... here, ...
>
>        /* Create a character length variable.  */

... and the couple of new utilility functions need to be updated as well.

I have one more comment, and one additional testcase.

> diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
> index 7d23515e5d8..0146cbd318a 100644
> --- a/gcc/fortran/trans-array.cc
> +++ b/gcc/fortran/trans-array.cc
> @@ -553,6 +571,8 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
>    tree tmp;
>    gfc_symbol *sym = (expr && expr->expr_type == EXPR_VARIABLE) ?
>  		    expr->symtree->n.sym : NULL;
> +  tree span_desc = (sym && sym->backend_decl)
> +		   ? saved_desc_pointer_array (sym->backend_decl) : NULL_TREE;
>  
>    if (is_pointer_array (desc)
>        || (get_CFI_desc (NULL, expr, &desc, NULL)
> @@ -560,11 +580,8 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
>  	      ? GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (desc)))
>  	      : GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))))
>      {
> -      if (POINTER_TYPE_P (TREE_TYPE (desc)))
> -	desc = build_fold_indirect_ref_loc (input_location, desc);
> -
>        /* This will have the span field set.  */
> -      tmp = gfc_conv_descriptor_span_get (desc);
> +      tmp = gfc_conv_descriptor_span_get (gfc_get_span_descriptor (desc));
>      }
>    else if (expr->ts.type == BT_ASSUMED)
>      {
> @@ -588,6 +605,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
>      /* Having escaped the above, this can only be a class array dummy.  */
>      tmp = class_array_element_size (sym->backend_decl,
>  				    UNLIMITED_POLY (sym));
> +  else if (span_desc
> +	   && (expr->ref == NULL
> +	       || (expr->ref->type == REF_ARRAY && expr->ref->next == NULL)))

It doesn't seem to be correct to check the absence of any subreference.
The span is a property of the array; it doesn't depend on subreferences.
Even if there is a subreference after it, the array reference should
continue to use spanned array indexing.  The program below regresses for
example (not sure it's related to this condition).  Surprisingly it
doesn't seem to be covered by the testsuite.

program p
   implicit none
   type :: t
     integer :: c1, c2
   end type
   type, extends(t) :: u
     integer :: c3
   end type
   type, extends(u) :: v
     integer :: c4
   end type
   type(v), target :: x(12)
   integer :: i
   x = [(v(i,i*i,i,i), i=1,size(x))]
   call s1(x(2::3)%c2, 1)
   call s2(x%u)
contains
   subroutine s1(a, error_idx)
     integer, intent(in) :: error_idx
     integer, target :: a(:)
     print *, a
     if (any(a /= [4, 25, 64, 121])) error stop error_idx * 10 + 1
   end subroutine
   subroutine s2(a)
     type(u), target :: a(:)
     print *, a(2::3)%c2
     if (any(a(2::3)%c2 /= [4, 25, 64, 121])) error stop 2
     call s1(a(2::3)%c2, 2)
   end subroutine
end program

> +    {
> +      /* A descriptorless dummy re-passed to another procedure. Read its
> +	 span from the saved descriptor.  */
> +      if (POINTER_TYPE_P (TREE_TYPE (span_desc)))
> +	span_desc = build_fold_indirect_ref_loc (input_location, span_desc);
> +      tmp = gfc_conv_descriptor_span_get (span_desc);
> +
> +      /* An absent optional dummy has no valid saved descriptor to read;
> +	 avoid trying to use it and fall back to the static element size. */
> +      if (sym->attr.dummy && sym->attr.optional)
> +	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
> +			   gfc_conv_expr_present (sym), tmp,
> +			   fold_convert (TREE_TYPE (tmp),
> +					 TYPE_SIZE_UNIT (
> +					   gfc_get_element_type (TREE_TYPE (desc)))));
> +    }
>    else
>      {
>        /* If none of the fancy stuff works, the span is the element