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.
This commit is contained in:
parent
bc71318a91
commit
12b537b9b7
2 changed files with 78 additions and 2 deletions
|
@ -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)
|
||||
|
|
76
gcc/testsuite/gfortran.dg/PR100103.f90
Normal file
76
gcc/testsuite/gfortran.dg/PR100103.f90
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue