Hi Harald, Thanks for your help, please see the updated and signed-off patch below.
> (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.) I've included them in the patch here, but it does seem to work fine without checking those attributes here -- and invalid code is still caught with that change. It also occurred to me that array temporaries aren't _required_ here (for arrays of derived type components), but in the general case with a type with differently sized components, the stride wouldn't be a multiple of the component's type's size. Is it possible in principle to have an arbitrary stride? Cheers, Peter >From 907a104facfc7f35f48ebcfa9ef5f8f5430d4d3c Mon Sep 17 00:00:00 2001 From: Peter Hill <peter.h...@york.ac.uk> Date: Thu, 15 Feb 2024 16:58:33 +0000 Subject: [PATCH] Fortran: fix passing array component ref to polymorphic procedures PR fortran/105658 gcc/fortran/ChangeLog * trans-expr.cc (gfc_conv_intrinsic_to_class): 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. Signed-off-by: Peter Hill <peter.h...@york.ac.uk> --- gcc/fortran/trans-expr.cc | 9 +++++ gcc/testsuite/gfortran.dg/PR105658.f90 | 50 ++++++++++++++++++++++++++ 2 files changed, 59 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..004081aa6c3 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.allocatable + && !class_ts.u.derived->components->attr.class_pointer + && is_subref_array (e)) + parmse->force_tmp = 1; + /* Set the vptr. */ ctree = gfc_class_vptr_get (var); @@ -6439,6 +6447,7 @@ 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); + 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..8aacecf806e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR105658.f90 @@ -0,0 +1,50 @@ +! { 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 + 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 -- 2.43.0