Re: [PATCH] Fortran: fix passing array component to polymorphic argument [PR105658]

[Harald Anlauf <anlauf@gmx.de>]

Hi Peter,

thanks for your contribution to gfortran!  You've found indeed
a solution for a potentially annoying bug.

Am 15.02.24 um 18:50 schrieb Peter Hill:
> Dear all,
>
> The attached patch fixes PR105658 by forcing an array temporary to be
> created. This is required when passing an array component, but this
> didn't happen if the dummy argument was an unlimited polymorphic type.
>
> The problem bit of code is in `gfc_conv_expr_descriptor`, near L7828:
>
>        subref_array_target = (is_subref_array (expr)
>       && (se->direct_byref
> || expr->ts.type == BT_CHARACTER));
>        need_tmp = (gfc_ref_needs_temporary_p (expr->ref)
>    && !subref_array_target);
>
> where `need_tmp` is being evaluated to 0.  The logic here isn't clear
> to me, and this function is used in several places, which is why I
> went with setting `parmse.force_tmp = 1` in `gfc_conv_procedure_call`
> and using the same conditional as the later branch for the
> non-polymorphic case (near the call to `gfc_conv_subref_array_arg`)
>
> If this patch is ok, please could someone commit it for me? This is my
> first patch for GCC, so apologies in advance if the commit message is
> missing something.

Your patch mostly does the right thing.  Note that when fsym is
an unlimited polymorphic, some of its attributes are buried deep
within its internal representation.  I would also prefer to move
the code to gfc_conv_intrinsic_to_class where it seems to fit better,
like:

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a0593b76f18..db906caa52e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1019,6 +1019,14 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse,
gfc_expr *e,
    tmp = gfc_typenode_for_spec (&class_ts);
    var = gfc_create_var (tmp, "class");

+  /* Force a temporary for component or substring references.  */
+  if (unlimited_poly
+      && class_ts.u.derived->components->attr.dimension
+      && !class_ts.u.derived->components->attr.class_pointer
+      && !class_ts.u.derived->components->attr.allocatable
+      && is_subref_array (e))
+    parmse->force_tmp = 1;
+
    /* Set the vptr.  */
    ctree = gfc_class_vptr_get (var);

(I am not entirely sure whether we need to exclude pointer and
allocatable attributes here explicitly, given the constraints
in F2023:15.5.2.6, but other may have an opinion, too.
The above should be safe anyway.)

> Tested on x86_64-pc-linux-gnu.
>
> The bug is present in gfortran back to 4.9, so should it also be backported?

I think we'll target 14-mainline and might consider a backport to
13-branch.

> Cheers,
> Peter
>
>           PR fortran/105658
>
> gcc/fortran/ChangeLog
>
>          * trans-expr.cc (gfc_conv_procedure_call): When passing an
>          array component reference of intrinsic type to a procedure
>          with an unlimited polymorphic dummy argument, a temporary
>          should be created.
>
> gcc/testsuite/ChangeLog
>
>          * gfortran.dg/PR105658.f90: New test.
> ---
>   gcc/fortran/trans-expr.cc              |  8 ++++++++
>   gcc/testsuite/gfortran.dg/PR105658.f90 | 25 +++++++++++++++++++++++++
>   2 files changed, 33 insertions(+)
>   create mode 100644 gcc/testsuite/gfortran.dg/PR105658.f90
>
> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index a0593b76f18..7fd3047c4e9 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc
> @@ -6439,6 +6439,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>         CLASS object for the unlimited polymorphic formal.  */
>      gfc_find_vtab (&e->ts);
>      gfc_init_se (&parmse, se);
> +   /* The actual argument is a component reference to an array
> +      of derived types, so we need to force creation of a
> +      temporary */
> +   if (e->expr_type == EXPR_VARIABLE
> +       && is_subref_array (e)
> +       && !(fsym && fsym->attr.pointer))
> +     parmse.force_tmp = 1;
> +
>      gfc_conv_intrinsic_to_class (&parmse, e, fsym->ts);
>
>    }
> diff --git a/gcc/testsuite/gfortran.dg/PR105658.f90
> b/gcc/testsuite/gfortran.dg/PR105658.f90
> new file mode 100644
> index 00000000000..407ee25f77c
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/PR105658.f90
> @@ -0,0 +1,25 @@
> +! { dg-do compile }
> +! { dg-options "-Warray-temporaries" }
> +! Test fix for incorrectly passing array component to unlimited
> polymorphic procedure
> +
> +module test_PR105658_mod
> +  implicit none
> +  type :: foo
> +    integer :: member1
> +    integer :: member2
> +  end type foo
> +contains
> +  subroutine print_poly(array)
> +    class(*), dimension(:), intent(in) :: array
> +    select type(array)
> +    type is (integer)
> +      print*, array
> +    end select
> +  end subroutine print_poly
> +
> +  subroutine do_print(thing)
> +    type(foo), dimension(3), intent(in) :: thing
> +    call print_poly(thing%member1) ! { dg-warning "array temporary" }
> +  end subroutine do_print
> +
> +end module test_PR105658_mod

One could extend this testcase to cover substrings as well:

module test_PR105658_mod
   implicit none
   type :: foo
     integer :: member1
     integer :: member2
   end type foo
contains
   subroutine print_poly(array)
     class(*), dimension(:), intent(in) :: array
     select type(array)
     type is (integer)
       print*, array
     type is (character(*))
       print *, array
     end select
   end subroutine print_poly

   subroutine do_print(thing)
     type(foo), dimension(3), intent(in) :: thing
     type(foo), parameter :: y(3) = [foo(1,2),foo(3,4),foo(5,6)]
     integer :: i, j, uu(5,6)

     call print_poly(thing%member1)   ! { dg-warning "array temporary" }
     call print_poly(y%member2)       ! { dg-warning "array temporary" }
     call print_poly(y(1::2)%member2) ! { dg-warning "array temporary" }

     ! The following array sections work without temporaries
     uu = reshape([(((10*i+j),i=1,5),j=1,6)],[5,6])
     print *, uu(2,2::2)
     call print_poly (uu(2,2::2))     ! no temp needed!
     print *, uu(1::2,6)
     call print_poly (uu(1::2,6))     ! no temp needed!
   end subroutine do_print

   subroutine do_print2(thing2)
     class(foo), dimension(:), intent(in) :: thing2
     call print_poly (thing2% member2) ! { dg-warning "array temporary" }
   end subroutine do_print2

   subroutine do_print3 ()
     character(3) :: c(3) = ["abc","def","ghi"]
     call print_poly (c(1::2))      ! no temp needed!
     call print_poly (c(1::2)(2:3)) ! { dg-warning "array temporary" }
   end subroutine do_print3

end module test_PR105658_mod


If you like, you can repackage the patch and sign it
(see https://gcc.gnu.org/dco.html), and one of us will
then commit it for you.

Thanks!

Harald