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

Reply via email to