Dear all, the patch for this PR was submitted for review by Jose here:
https://gcc.gnu.org/pipermail/fortran/2021-April/055934.html but unfortunately was never reviewed. I verified that it works on mainline and x86_64-pc-linux-gnu, and I think that it is fine. Although the above mail suggests that there is a dependency on the fix for another PR with a rather lengthy patch, it appears that this is no longer the case. It might be that the fix for PR100245 (another reallocation issue) already did the necessary job. So OK for mainline? Thanks, Harald
From 6c93c5058f552f47a3d828d3fb19cca652901299 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= <jrfso...@gmail.com> Date: Wed, 21 Sep 2022 22:55:02 +0200 Subject: [PATCH] Fortran: Fix automatic reallocation inside select rank [PR100103] gcc/fortran/ChangeLog: PR fortran/100103 * trans-array.cc (gfc_is_reallocatable_lhs): Add select rank temporary associate names as possible targets of automatic reallocation. gcc/testsuite/ChangeLog: PR fortran/100103 * gfortran.dg/PR100103.f90: New test. --- gcc/fortran/trans-array.cc | 4 +- gcc/testsuite/gfortran.dg/PR100103.f90 | 76 ++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100103.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 05134952db4..795ce14af08 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -10378,7 +10378,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr) /* An allocatable class variable with no reference. */ if (sym->ts.type == BT_CLASS - && !sym->attr.associate_var + && (!sym->attr.associate_var || sym->attr.select_rank_temporary) && CLASS_DATA (sym)->attr.allocatable && expr->ref && ((expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL @@ -10393,7 +10393,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr) /* An allocatable variable. */ if (sym->attr.allocatable - && !sym->attr.associate_var + && (!sym->attr.associate_var || sym->attr.select_rank_temporary) && expr->ref && expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL) diff --git a/gcc/testsuite/gfortran.dg/PR100103.f90 b/gcc/testsuite/gfortran.dg/PR100103.f90 new file mode 100644 index 00000000000..21405610a71 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100103.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! +! Test the fix for PR100103 +! + +program main_p + implicit none + + integer :: i + integer, parameter :: n = 11 + + type :: foo_t + integer :: i + end type foo_t + + type(foo_t), parameter :: a(*) = [(foo_t(i), i=1,n)] + + type(foo_t), allocatable :: bar_d(:) + class(foo_t), allocatable :: bar_p(:) + class(*), allocatable :: bar_u(:) + + + call foo_d(bar_d) + if(.not.allocated(bar_d)) stop 1 + if(any(bar_d%i/=a%i)) stop 2 + deallocate(bar_d) + call foo_p(bar_p) + if(.not.allocated(bar_p)) stop 3 + if(any(bar_p%i/=a%i)) stop 4 + deallocate(bar_p) + call foo_u(bar_u) + if(.not.allocated(bar_u)) stop 5 + select type(bar_u) + type is(foo_t) + if(any(bar_u%i/=a%i)) stop 6 + class default + stop 7 + end select + deallocate(bar_u) + +contains + + subroutine foo_d(that) + type(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + that = a + rank default + stop 8 + end select + end subroutine foo_d + + subroutine foo_p(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + that = a + rank default + stop 9 + end select + end subroutine foo_p + + subroutine foo_u(that) + class(*), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + that = a + rank default + stop 10 + end select + end subroutine foo_u + +end program main_p -- 2.35.3