blob: de29dac64dfd8725775f65cf154c76f3e2951374 [file] [log] [blame]
! { dg-do run }
!
! Testcase contributed by Andre Vehreschild <vehre@gcc.gnu.org>
module module_finalize_29
implicit none
! The type name is encoding the state of its finalizer being
! elemental (second letter 'e'), or non-element (second letter 'n')
! or array shaped (second letter 'a'), or shape-specific routine
! (generic; second letter 'g'),
! and whether the init-routine is elemental or not (third letter
! either 'e' or 'n').
type ten
integer :: i = 40
contains
final :: ten_fin
end type ten
type tee
integer :: i = 41
contains
final :: tee_fin
end type tee
type tne
integer :: i = 42
contains
final :: tne_fin
end type tne
type tnn
integer :: i = 43
contains
final :: tnn_fin
end type tnn
type tae
integer :: i = 44
contains
final :: tae_fin
end type tae
type tan
integer :: i = 45
contains
final :: tan_fin
end type tan
type tge
integer :: i = 46
contains
final :: tge_scalar_fin, tge_array_fin
end type tge
type tgn
integer :: i = 47
contains
final :: tgn_scalar_fin, tgn_array_fin
end type tgn
integer :: ten_fin_counts, tee_fin_counts, tne_fin_counts, tnn_fin_counts
integer :: tae_fin_counts, tan_fin_counts
integer :: tge_scalar_fin_counts, tge_array_fin_counts
integer :: tgn_scalar_fin_counts, tgn_array_fin_counts
contains
impure elemental subroutine ten_fin(x)
type(ten), intent(inout) :: x
x%i = -10 * x%i
ten_fin_counts = ten_fin_counts + 1
end subroutine ten_fin
impure elemental subroutine tee_fin(x)
type(tee), intent(inout) :: x
x%i = -11 * x%i
tee_fin_counts = tee_fin_counts + 1
end subroutine tee_fin
subroutine tne_fin(x)
type(tne), intent(inout) :: x
x%i = -12 * x%i
tne_fin_counts = tne_fin_counts + 1
end subroutine tne_fin
subroutine tnn_fin(x)
type(tnn), intent(inout) :: x
x%i = -13 * x%i
tnn_fin_counts = tnn_fin_counts + 1
end subroutine tnn_fin
subroutine tae_fin(x)
type(tae), intent(inout) :: x(:,:)
x%i = -14 * x%i
tae_fin_counts = tae_fin_counts + 1
end subroutine tae_fin
subroutine tan_fin(x)
type(tan), intent(inout) :: x(:,:)
x%i = -15 * x%i
tan_fin_counts = tan_fin_counts + 1
end subroutine tan_fin
subroutine tge_scalar_fin(x)
type(tge), intent(inout) :: x
x%i = -16 * x%i
tge_scalar_fin_counts = tge_scalar_fin_counts + 1
end subroutine tge_scalar_fin
subroutine tge_array_fin(x)
type(tge), intent(inout) :: x(:,:)
x%i = -17 * x%i
tge_array_fin_counts = tge_array_fin_counts + 1
end subroutine tge_array_fin
subroutine tgn_scalar_fin(x)
type(tgn), intent(inout) :: x
x%i = -18 * x%i
tgn_scalar_fin_counts = tgn_scalar_fin_counts + 1
end subroutine tgn_scalar_fin
subroutine tgn_array_fin(x)
type(tgn), intent(inout) :: x(:,:)
x%i = -19 * x%i
tgn_array_fin_counts = tgn_array_fin_counts + 1
end subroutine tgn_array_fin
! The finalizer/initializer call producer
subroutine ten_init(x)
class(ten), intent(out) :: x(:,:)
end subroutine ten_init
impure elemental subroutine tee_init(x)
class(tee), intent(out) :: x
end subroutine tee_init
impure elemental subroutine tne_init(x)
class(tne), intent(out) :: x
end subroutine tne_init
subroutine tnn_init(x)
class(tnn), intent(out) :: x(:,:)
end subroutine tnn_init
impure elemental subroutine tae_init(x)
class(tae), intent(out) :: x
end subroutine tae_init
subroutine tan_init(x)
class(tan), intent(out) :: x(:,:)
end subroutine tan_init
impure elemental subroutine tge_init(x)
class(tge), intent(out) :: x
end subroutine tge_init
subroutine tgn_init(x)
class(tgn), intent(out) :: x(:,:)
end subroutine tgn_init
end module module_finalize_29
program finalize_29
use module_finalize_29
implicit none
type(ten), allocatable :: x_ten(:,:)
type(tee), allocatable :: x_tee(:,:)
type(tne), allocatable :: x_tne(:,:)
type(tnn), allocatable :: x_tnn(:,:)
type(tae), allocatable :: x_tae(:,:)
type(tan), allocatable :: x_tan(:,:)
type(tge), allocatable :: x_tge(:,:)
type(tgn), allocatable :: x_tgn(:,:)
! Set the global counts to zero.
ten_fin_counts = 0
tee_fin_counts = 0
tne_fin_counts = 0
tnn_fin_counts = 0
tae_fin_counts = 0
tan_fin_counts = 0
tge_scalar_fin_counts = 0
tge_array_fin_counts = 0
tgn_scalar_fin_counts = 0
tgn_array_fin_counts = 0
allocate(ten :: x_ten(5,5))
allocate(tee :: x_tee(5,5))
allocate(tne :: x_tne(5,5))
allocate(tnn :: x_tnn(5,5))
allocate(tae :: x_tae(5,5))
allocate(tan :: x_tan(5,5))
allocate(tge :: x_tge(5,5))
allocate(tgn :: x_tgn(5,5))
x_ten%i = 1
x_tee%i = 2
x_tne%i = 3
x_tnn%i = 4
x_tae%i = 5
x_tan%i = 6
x_tge%i = 7
x_tgn%i = 8
call ten_init(x_ten(::2, ::3))
if (ten_fin_counts /= 6) STOP 1
if (tee_fin_counts + tne_fin_counts + tnn_fin_counts + tae_fin_counts + &
tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 2
ten_fin_counts = 0
call tee_init(x_tee(::2, ::3))
if (tee_fin_counts /= 6) STOP 3
if (ten_fin_counts + tne_fin_counts + tnn_fin_counts + tae_fin_counts + &
tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 4
tee_fin_counts = 0
call tne_init(x_tne(::2, ::3))
if (tne_fin_counts /= 6) STOP 5
if (ten_fin_counts + tee_fin_counts + tnn_fin_counts + tae_fin_counts + &
tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 6
tne_fin_counts = 0
call tnn_init(x_tnn(::2, ::3))
if (tnn_fin_counts /= 0) STOP 7
if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tae_fin_counts + &
tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 8
call tae_init(x_tae(::2, ::3))
if (tae_fin_counts /= 0) STOP 9
if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 10
call tan_init(x_tan(::2, ::3))
if (tan_fin_counts /= 1) STOP 11
if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
tae_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 12
tan_fin_counts = 0
call tge_init(x_tge(::2, ::3))
if (tge_scalar_fin_counts /= 6) STOP 13
if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
tae_fin_counts + tan_fin_counts + tgn_array_fin_counts + &
tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) STOP 14
tge_scalar_fin_counts = 0
call tgn_init(x_tgn(::2, ::3))
if (tgn_array_fin_counts /= 1) STOP 15
if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
tae_fin_counts + tan_fin_counts + tge_scalar_fin_counts + &
tge_array_fin_counts + tgn_scalar_fin_counts /= 0) STOP 16
tgn_array_fin_counts = 0
if (any (reshape (x_ten%i, [25]) /= [[40, 1, 40, 1, 40], [1, 1, 1, 1, 1],&
[1, 1, 1, 1, 1], [40, 1, 40, 1, 40], [1, 1, 1, 1, 1]])) STOP 17
if (any (reshape (x_tee%i, [25]) /= [[41, 2, 41, 2, 41], [2, 2, 2, 2, 2],&
[2, 2, 2, 2, 2], [41, 2, 41, 2, 41], [2, 2, 2, 2, 2]])) STOP 18
if (any (reshape (x_tne%i, [25]) /= [[42, 3, 42, 3, 42], [3, 3, 3, 3, 3],&
[3, 3, 3, 3, 3], [42, 3, 42, 3, 42], [3, 3, 3, 3, 3]])) STOP 19
if (any (reshape (x_tnn%i, [25]) /= [[43, 4, 43, 4, 43], [4, 4, 4, 4, 4],&
[4, 4, 4, 4, 4], [43, 4, 43, 4, 43], [4, 4, 4, 4, 4]])) STOP 20
if (any (reshape (x_tae%i, [25]) /= [[44, 5, 44, 5, 44], [5, 5, 5, 5, 5],&
[5, 5, 5, 5, 5], [44, 5, 44, 5, 44], [5, 5, 5, 5, 5]])) STOP 21
if (any (reshape (x_tan%i, [25]) /= [[45, 6, 45, 6, 45], [6, 6, 6, 6, 6],&
[6, 6, 6, 6, 6], [45, 6, 45, 6, 45], [6, 6, 6, 6, 6]])) STOP 22
if (any (reshape (x_tge%i, [25]) /= [[46, 7, 46, 7, 46], [7, 7, 7, 7, 7],&
[7, 7, 7, 7, 7], [46, 7, 46, 7, 46], [7, 7, 7, 7, 7]])) STOP 23
if (any (reshape (x_tgn%i, [25]) /= [[47, 8, 47, 8, 47], [8, 8, 8, 8, 8],&
[8, 8, 8, 8, 8], [47, 8, 47, 8, 47], [8, 8, 8, 8, 8]])) STOP 24
end program finalize_29