blob: 61d017545e90e41cddde930cf97433b282a546f9 [file] [log] [blame]
! { dg-do run }
!
! PR fortran/37336
!
module m
implicit none
type t
integer :: i
contains
final :: fini3, fini2, fini_elm
end type t
type, extends(t) :: t2
integer :: j
contains
final :: f2ini2, f2ini_elm
end type t2
logical :: elem_call
logical :: rank2_call
logical :: rank3_call
integer :: cnt, cnt2
integer :: fini_call
contains
subroutine fini2 (x)
type(t), intent(in), contiguous :: x(:,:)
if (.not. rank2_call) STOP 1
if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 2
!print *, 'fini2:', x%i
if (any (x%i /= reshape([11, 12, 21, 22, 31, 32], [2,3]))) STOP 3
fini_call = fini_call + 1
end subroutine
subroutine fini3 (x)
type(t), intent(in) :: x(2,2,*)
integer :: i,j,k
if (.not. elem_call) STOP 4
if (.not. rank3_call) STOP 5
if (cnt2 /= 9) STOP 6
if (cnt /= 1) STOP 7
do i = 1, 2
do j = 1, 2
do k = 1, 2
!print *, k,j,i,x(k,j,i)%i
if (x(k,j,i)%i /= k+10*j+100*i) STOP 8
end do
end do
end do
fini_call = fini_call + 1
end subroutine
impure elemental subroutine fini_elm (x)
type(t), intent(in) :: x
if (.not. elem_call) STOP 9
if (rank3_call) STOP 10
if (cnt2 /= 6) STOP 11
if (cnt /= x%i) STOP 12
!print *, 'fini_elm:', cnt, x%i
fini_call = fini_call + 1
cnt = cnt + 1
end subroutine
subroutine f2ini2 (x)
type(t2), intent(in), target :: x(:,:)
if (.not. rank2_call) STOP 13
if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 14
!print *, 'f2ini2:', x%i
!print *, 'f2ini2:', x%j
if (any (x%i /= reshape([11, 12, 21, 22, 31, 32], [2,3]))) STOP 15
if (any (x%j /= 100*reshape([11, 12, 21, 22, 31, 32], [2,3]))) STOP 16
fini_call = fini_call + 1
end subroutine
impure elemental subroutine f2ini_elm (x)
type(t2), intent(in) :: x
integer, parameter :: exprected(*) &
= [111, 112, 121, 122, 211, 212, 221, 222]
if (.not. elem_call) STOP 17
!print *, 'f2ini_elm:', cnt2, x%i, x%j
if (rank3_call) then
if (x%i /= exprected(cnt2)) STOP 18
if (x%j /= 1000*exprected(cnt2)) STOP 19
else
if (cnt2 /= x%i .or. cnt2*10 /= x%j) STOP 20
end if
cnt2 = cnt2 + 1
fini_call = fini_call + 1
end subroutine
end module m
program test
use m
implicit none
class(t), save, allocatable :: y(:), z(:,:), zz(:,:,:)
target :: z, zz
integer :: i,j,k
elem_call = .false.
rank2_call = .false.
rank3_call = .false.
allocate (t2 :: y(5))
select type (y)
type is (t2)
do i = 1, 5
y(i)%i = i
y(i)%j = i*10
end do
end select
cnt = 1
cnt2 = 1
fini_call = 0
elem_call = .true.
deallocate (y)
if (fini_call /= 10) STOP 21
elem_call = .false.
rank2_call = .false.
rank3_call = .false.
allocate (t2 :: z(2,3))
select type (z)
type is (t2)
do i = 1, 3
do j = 1, 2
z(j,i)%i = j+10*i
z(j,i)%j = (j+10*i)*100
end do
end do
end select
cnt = 1
cnt2 = 1
fini_call = 0
rank2_call = .true.
deallocate (z)
if (fini_call /= 2) STOP 22
elem_call = .false.
rank2_call = .false.
rank3_call = .false.
allocate (t2 :: zz(2,2,2))
select type (zz)
type is (t2)
do i = 1, 2
do j = 1, 2
do k = 1, 2
zz(k,j,i)%i = k+10*j+100*i
zz(k,j,i)%j = (k+10*j+100*i)*1000
end do
end do
end do
end select
cnt = 1
cnt2 = 1
fini_call = 0
rank3_call = .true.
elem_call = .true.
deallocate (zz)
if (fini_call /= 2*2*2+1) STOP 23
end program test