From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id C32C3385AC3C; Sat, 1 Oct 2022 18:17:33 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C32C3385AC3C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1664648253; bh=lYxgJKT0ABxKpsJayHblExH1Q7ITBDszhB0caJHWe/I=; h=From:To:Subject:Date:From; b=JMoOqVWQp3xXCWH1D/5OJPQp5huWcYpsYUNBbEvnnY5EAlllJ/rKwjYJbcaqrBExu WUFx7oOMTtmiXM1KnLB84vy6a4+ABHUjvicVHSROZvYQA7hhmix6BvW2ctvHXoF6JA B4vKn9r7N2RP/sl/WPcMBoNU/sSwnX+gzhjNJD3k= MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-8803] Fortran: Fix automatic reallocation inside select rank [PR100103] X-Act-Checkin: gcc X-Git-Author: =?utf-8?q?Jos=C3=A9_Rui_Faustino_de_Sousa?= X-Git-Refname: refs/heads/releases/gcc-12 X-Git-Oldrev: 9de83c0939dabdbefcb88dfef3ad7caf932951ec X-Git-Newrev: 56275fd23e3f7876c24a812f9b6776b00a94744e Message-Id: <20221001181733.C32C3385AC3C@sourceware.org> Date: Sat, 1 Oct 2022 18:17:33 +0000 (GMT) List-Id: https://gcc.gnu.org/g:56275fd23e3f7876c24a812f9b6776b00a94744e commit r12-8803-g56275fd23e3f7876c24a812f9b6776b00a94744e Author: José Rui Faustino de Sousa Date: Wed Sep 21 22:55:02 2022 +0200 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. (cherry picked from commit 12b537b9b7fd50f4b2fbfcb7ccf45f8d66085577) Diff: --- gcc/fortran/trans-array.cc | 4 +- gcc/testsuite/gfortran.dg/PR100103.f90 | 76 ++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 2 deletions(-) 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