diff options
| author | Peter Hill <peter.hill@york.ac.uk> | 2024-02-20 20:42:53 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2024-02-20 20:50:01 +0100 |
| commit | 14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2 (patch) | |
| tree | 1cd6ed4471bac28787b4a5496001c984638140b1 | |
| parent | 81e5f276c59897077ffe38202849c93e9c580c41 (diff) | |
| download | gcc-14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2.zip gcc-14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2.tar.gz gcc-14ba8d5b87acd5f91ab8b8c02165a0fd53dcc2f2.tar.bz2 | |
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.hill@york.ac.uk>
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/PR105658.f90 | 50 |
2 files changed, 58 insertions, 0 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3506e4e..118dfd7 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 0000000..8aacecf --- /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 |