view gcc/testsuite/gfortran.dg/finalize_29.f08 @ 128:fe568345ddd5

fix CbC-example
author mir3636
date Wed, 11 Apr 2018 19:32:28 +0900
parents 04ced10e8804
children 84e7813d76e9
line wrap: on
line source

! { 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) call abort()
  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) call abort()
  ten_fin_counts = 0

  call tee_init(x_tee(::2, ::3))

  if (tee_fin_counts /= 6) call abort()
  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) call abort()
  tee_fin_counts = 0

  call tne_init(x_tne(::2, ::3))

  if (tne_fin_counts /= 6) call abort()
  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) call abort()
  tne_fin_counts = 0

  call tnn_init(x_tnn(::2, ::3))

  if (tnn_fin_counts /= 0) call abort()
  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) call abort()

  call tae_init(x_tae(::2, ::3))

  if (tae_fin_counts /= 0) call abort()
  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) call abort()

  call tan_init(x_tan(::2, ::3))

  if (tan_fin_counts /= 1) call abort()
  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) call abort()
  tan_fin_counts = 0

  call tge_init(x_tge(::2, ::3))

  if (tge_scalar_fin_counts /= 6) call abort()
  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) call abort()
  tge_scalar_fin_counts = 0

  call tgn_init(x_tgn(::2, ::3))

  if (tgn_array_fin_counts /= 1) call abort()
  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) call abort()
  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]])) call abort()

  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]])) call abort()

  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]])) call abort()

  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]])) call abort()

  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]])) call abort()

  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]])) call abort()

  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]])) call abort()

  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]])) call abort()
end program finalize_29