blob: d9488e5d3aab62100121bedf503f64d52ae773da [file] [log] [blame]
! { dg-do run }
!
! Contributed by Andre Vehreschild
! Check more elaborate class array addressing.
module m1
type InnerBaseT
integer, allocatable :: a(:)
end type InnerBaseT
type, extends(InnerBaseT) :: InnerT
integer :: i
end type InnerT
type BaseT
class(InnerT), allocatable :: arr(:,:)
contains
procedure P
end type BaseT
contains
subroutine indir(this, mat)
class(BaseT) :: this
class(InnerT), intent(inout) :: mat(:,:)
call this%P(mat)
end subroutine indir
subroutine P(this, mat)
class(BaseT) :: this
class(InnerT), intent(inout) :: mat(:,:)
integer :: i,j
mat%i = 42
do i= 1, ubound(mat, 1)
do j= 1, ubound(mat, 2)
if (.not. allocated(mat(i,j)%a)) then
allocate(mat(i,j)%a(10), source = 72)
end if
end do
end do
mat(1,1)%i = 9
mat(1,1)%a(5) = 1
end subroutine
end module m1
program test
use m1
class(BaseT), allocatable, target :: o
class(InnerT), pointer :: i_p(:,:)
class(InnerBaseT), allocatable :: i_a(:,:)
integer i,j,l
allocate(o)
allocate(o%arr(2,2))
allocate(InnerT::i_a(2,2))
o%arr%i = 1
i_p => o%arr
call o%P(i_p)
if (any(o%arr%i /= reshape([9,42,42,42],[2,2]))) STOP 1
do l= 1, 10
do i= 1, 2
do j= 1,2
if ((i == 1 .and. j == 1 .and. l == 5 .and. &
o%arr(i,j)%a(5) /= 1) &
.or. (.not. (i == 1 .and. j == 1 .and. l == 5) &
.and. o%arr(i,j)%a(l) /= 72)) STOP 2
end do
end do
end do
select type (i_a)
type is (InnerT)
call o%P(i_a)
do l= 1, 10
do i= 1, 2
do j= 1,2
if ((i == 1 .and. j == 1 .and. l == 5 .and. &
i_a(i,j)%a(5) /= 1) &
.or. (.not. (i == 1 .and. j == 1 .and. l == 5) &
.and. i_a(i,j)%a(l) /= 72)) STOP 3
end do
end do
end do
end select
i_p%i = 4
call indir(o, i_p)
if (any(o%arr%i /= reshape([9,42,42,42],[2,2]))) STOP 4
end program test
! vim:ts=2:sts=2:cindent:sw=2:tw=80: