From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id A6BB33858408; Tue, 20 Feb 2024 19:50:34 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A6BB33858408 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1708458634; bh=UsXPd2Q2Sk3yeo/tpiWNdCWWlPBnQqWUXzFIvKLaa+s=; h=From:To:Subject:Date:From; b=MfDR9f8/19i0MUia+JpdVp4+qYRRWqsxQNa/Sj6JVNqOlrkrGki4Sf6o51lFFTp6O Nn1nlbhCTjnSE9nmimHtRXkwjoKPvpWIzAd0XaQTsitwlvosjfuUuvFfyZwgqfFcLO O2HXVohsTObRdpMO/oeb2hwjo6cHawcPA7pVLsFk= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-9086] Fortran: fix passing array component ref to polymorphic procedures X-Act-Checkin: gcc X-Git-Author: Peter Hill X-Git-Refname: refs/heads/master X-Git-Oldrev: 81e5f276c59897077ffe38202849c93e9c580c41 X-Git-Newrev: 14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2 Message-Id: <20240220195034.A6BB33858408@sourceware.org> Date: Tue, 20 Feb 2024 19:50:34 +0000 (GMT) List-Id: https://gcc.gnu.org/g:14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2 commit r14-9086-g14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2 Author: Peter Hill Date: Tue Feb 20 20:42:53 2024 +0100 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 Diff: --- gcc/fortran/trans-expr.cc | 8 ++++++ gcc/testsuite/gfortran.dg/PR105658.f90 | 50 ++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3506e4e4cb0b..118dfd7c9b23 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); diff --git a/gcc/testsuite/gfortran.dg/PR105658.f90 b/gcc/testsuite/gfortran.dg/PR105658.f90 new file mode 100644 index 000000000000..8aacecf806e7 --- /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