gcc/testsuite/gfortran.dg/finalize_29.f08

   1 ! { dg-do run }
   2 !
   3 ! Testcase contributed by Andre Vehreschild  <vehre@gcc.gnu.org>
   4
   5 module module_finalize_29
   6   implicit none
   7
   8   ! The type name is encoding the state of its finalizer being
   9   ! elemental (second letter 'e'), or non-element (second letter 'n')
  10   ! or array shaped (second letter 'a'), or shape-specific routine
  11   ! (generic; second letter 'g'),
  12   ! and whether the init-routine is elemental or not (third letter
  13   ! either 'e' or 'n').
  14   type ten
  15     integer :: i = 40
  16   contains
  17     final :: ten_fin
  18   end type ten
  19
  20   type tee
  21     integer :: i = 41
  22   contains
  23     final :: tee_fin
  24   end type tee
  25
  26   type tne
  27     integer :: i = 42
  28   contains
  29     final :: tne_fin
  30   end type tne
  31
  32   type tnn
  33     integer :: i = 43
  34   contains
  35     final :: tnn_fin
  36   end type tnn
  37
  38   type tae
  39     integer :: i = 44
  40   contains
  41     final :: tae_fin
  42   end type tae
  43
  44   type tan
  45     integer :: i = 45
  46   contains
  47     final :: tan_fin
  48   end type tan
  49
  50   type tge
  51     integer :: i = 46
  52   contains
  53     final :: tge_scalar_fin, tge_array_fin
  54   end type tge
  55
  56   type tgn
  57     integer :: i = 47
  58   contains
  59     final :: tgn_scalar_fin, tgn_array_fin
  60   end type tgn
  61
  62   integer :: ten_fin_counts, tee_fin_counts, tne_fin_counts, tnn_fin_counts
  63   integer :: tae_fin_counts, tan_fin_counts
  64   integer :: tge_scalar_fin_counts, tge_array_fin_counts
  65   integer :: tgn_scalar_fin_counts, tgn_array_fin_counts
  66 contains
  67   impure elemental subroutine ten_fin(x)
  68     type(ten), intent(inout) :: x
  69     x%i = -10 * x%i
  70     ten_fin_counts = ten_fin_counts + 1
  71   end subroutine ten_fin
  72
  73   impure elemental subroutine tee_fin(x)
  74     type(tee), intent(inout) :: x
  75     x%i = -11 * x%i
  76     tee_fin_counts = tee_fin_counts + 1
  77   end subroutine tee_fin
  78
  79   subroutine tne_fin(x)
  80     type(tne), intent(inout) :: x
  81     x%i = -12 * x%i
  82     tne_fin_counts = tne_fin_counts + 1
  83   end subroutine tne_fin
  84
  85   subroutine tnn_fin(x)
  86     type(tnn), intent(inout) :: x
  87     x%i = -13 * x%i
  88     tnn_fin_counts = tnn_fin_counts + 1
  89   end subroutine tnn_fin
  90
  91   subroutine tae_fin(x)
  92     type(tae), intent(inout) :: x(:,:)
  93     x%i = -14 * x%i
  94     tae_fin_counts = tae_fin_counts + 1
  95   end subroutine tae_fin
  96
  97   subroutine tan_fin(x)
  98     type(tan), intent(inout) :: x(:,:)
  99     x%i = -15 * x%i
 100     tan_fin_counts = tan_fin_counts + 1
 101   end subroutine tan_fin
 102
 103   subroutine tge_scalar_fin(x)
 104     type(tge), intent(inout) :: x
 105     x%i = -16 * x%i
 106     tge_scalar_fin_counts = tge_scalar_fin_counts + 1
 107   end subroutine tge_scalar_fin
 108
 109   subroutine tge_array_fin(x)
 110     type(tge), intent(inout) :: x(:,:)
 111     x%i = -17 * x%i
 112     tge_array_fin_counts = tge_array_fin_counts + 1
 113   end subroutine tge_array_fin
 114
 115   subroutine tgn_scalar_fin(x)
 116     type(tgn), intent(inout) :: x
 117     x%i = -18 * x%i
 118     tgn_scalar_fin_counts = tgn_scalar_fin_counts + 1
 119   end subroutine tgn_scalar_fin
 120
 121   subroutine tgn_array_fin(x)
 122     type(tgn), intent(inout) :: x(:,:)
 123     x%i = -19 * x%i
 124     tgn_array_fin_counts = tgn_array_fin_counts + 1
 125   end subroutine tgn_array_fin
 126
 127   ! The finalizer/initializer call producer
 128   subroutine ten_init(x)
 129     class(ten), intent(out) :: x(:,:)
 130   end subroutine ten_init
 131
 132   impure elemental subroutine tee_init(x)
 133     class(tee), intent(out) :: x
 134   end subroutine tee_init
 135
 136   impure elemental subroutine tne_init(x)
 137     class(tne), intent(out) :: x
 138   end subroutine tne_init
 139
 140   subroutine tnn_init(x)
 141     class(tnn), intent(out) :: x(:,:)
 142   end subroutine tnn_init
 143
 144   impure elemental subroutine tae_init(x)
 145     class(tae), intent(out) :: x
 146   end subroutine tae_init
 147
 148   subroutine tan_init(x)
 149     class(tan), intent(out) :: x(:,:)
 150   end subroutine tan_init
 151
 152   impure elemental subroutine tge_init(x)
 153     class(tge), intent(out) :: x
 154   end subroutine tge_init
 155
 156   subroutine tgn_init(x)
 157     class(tgn), intent(out) :: x(:,:)
 158   end subroutine tgn_init
 159 end module module_finalize_29
 160
 161 program finalize_29
 162   use module_finalize_29
 163   implicit none
 164
 165   type(ten), allocatable :: x_ten(:,:)
 166   type(tee), allocatable :: x_tee(:,:)
 167   type(tne), allocatable :: x_tne(:,:)
 168   type(tnn), allocatable :: x_tnn(:,:)
 169   type(tae), allocatable :: x_tae(:,:)
 170   type(tan), allocatable :: x_tan(:,:)
 171   type(tge), allocatable :: x_tge(:,:)
 172   type(tgn), allocatable :: x_tgn(:,:)
 173
 174   ! Set the global counts to zero.
 175   ten_fin_counts = 0
 176   tee_fin_counts = 0
 177   tne_fin_counts = 0
 178   tnn_fin_counts = 0
 179   tae_fin_counts = 0
 180   tan_fin_counts = 0
 181   tge_scalar_fin_counts = 0
 182   tge_array_fin_counts = 0
 183   tgn_scalar_fin_counts = 0
 184   tgn_array_fin_counts = 0
 185
 186   allocate(ten :: x_ten(5,5))
 187   allocate(tee :: x_tee(5,5))
 188   allocate(tne :: x_tne(5,5))
 189   allocate(tnn :: x_tnn(5,5))
 190   allocate(tae :: x_tae(5,5))
 191   allocate(tan :: x_tan(5,5))
 192   allocate(tge :: x_tge(5,5))
 193   allocate(tgn :: x_tgn(5,5))
 194
 195   x_ten%i = 1
 196   x_tee%i = 2
 197   x_tne%i = 3
 198   x_tnn%i = 4
 199   x_tae%i = 5
 200   x_tan%i = 6
 201   x_tge%i = 7
 202   x_tgn%i = 8
 203
 204   call ten_init(x_ten(::2, ::3))
 205
 206   if (ten_fin_counts /= 6) call abort()
 207   if (tee_fin_counts + tne_fin_counts + tnn_fin_counts + tae_fin_counts + &
 208         tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 209         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 210   ten_fin_counts = 0
 211
 212   call tee_init(x_tee(::2, ::3))
 213
 214   if (tee_fin_counts /= 6) call abort()
 215   if (ten_fin_counts + tne_fin_counts + tnn_fin_counts + tae_fin_counts + &
 216         tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 217         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 218   tee_fin_counts = 0
 219
 220   call tne_init(x_tne(::2, ::3))
 221
 222   if (tne_fin_counts /= 6) call abort()
 223   if (ten_fin_counts + tee_fin_counts + tnn_fin_counts + tae_fin_counts + &
 224         tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 225         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 226   tne_fin_counts = 0
 227
 228   call tnn_init(x_tnn(::2, ::3))
 229
 230   if (tnn_fin_counts /= 0) call abort()
 231   if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tae_fin_counts + &
 232         tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 233         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 234
 235   call tae_init(x_tae(::2, ::3))
 236
 237   if (tae_fin_counts /= 0) call abort()
 238   if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
 239         tan_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 240         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 241
 242   call tan_init(x_tan(::2, ::3))
 243
 244   if (tan_fin_counts /= 1) call abort()
 245   if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
 246         tae_fin_counts + tge_scalar_fin_counts + tge_array_fin_counts + &
 247         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 248   tan_fin_counts = 0
 249
 250   call tge_init(x_tge(::2, ::3))
 251
 252   if (tge_scalar_fin_counts /= 6) call abort()
 253   if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
 254         tae_fin_counts + tan_fin_counts + tgn_array_fin_counts + &
 255         tgn_scalar_fin_counts + tgn_array_fin_counts /= 0) call abort()
 256   tge_scalar_fin_counts = 0
 257
 258   call tgn_init(x_tgn(::2, ::3))
 259
 260   if (tgn_array_fin_counts /= 1) call abort()
 261   if (ten_fin_counts + tee_fin_counts + tne_fin_counts + tnn_fin_counts + &
 262         tae_fin_counts + tan_fin_counts + tge_scalar_fin_counts + &
 263         tge_array_fin_counts + tgn_scalar_fin_counts /= 0) call abort()
 264   tgn_array_fin_counts = 0
 265
 266   if (any (reshape (x_ten%i, [25]) /= [[40, 1, 40, 1, 40], [1, 1, 1, 1, 1],&
 267         [1, 1, 1, 1, 1], [40, 1, 40, 1, 40], [1, 1, 1, 1, 1]])) call abort()
 268
 269   if (any (reshape (x_tee%i, [25]) /= [[41, 2, 41, 2, 41], [2, 2, 2, 2, 2],&
 270         [2, 2, 2, 2, 2], [41, 2, 41, 2, 41], [2, 2, 2, 2, 2]])) call abort()
 271
 272   if (any (reshape (x_tne%i, [25]) /= [[42, 3, 42, 3, 42], [3, 3, 3, 3, 3],&
 273         [3, 3, 3, 3, 3], [42, 3, 42, 3, 42], [3, 3, 3, 3, 3]])) call abort()
 274
 275   if (any (reshape (x_tnn%i, [25]) /= [[43, 4, 43, 4, 43], [4, 4, 4, 4, 4],&
 276         [4, 4, 4, 4, 4], [43, 4, 43, 4, 43], [4, 4, 4, 4, 4]])) call abort()
 277
 278   if (any (reshape (x_tae%i, [25]) /= [[44, 5, 44, 5, 44], [5, 5, 5, 5, 5],&
 279         [5, 5, 5, 5, 5], [44, 5, 44, 5, 44], [5, 5, 5, 5, 5]])) call abort()
 280
 281   if (any (reshape (x_tan%i, [25]) /= [[45, 6, 45, 6, 45], [6, 6, 6, 6, 6],&
 282         [6, 6, 6, 6, 6], [45, 6, 45, 6, 45], [6, 6, 6, 6, 6]])) call abort()
 283
 284   if (any (reshape (x_tge%i, [25]) /= [[46, 7, 46, 7, 46], [7, 7, 7, 7, 7],&
 285         [7, 7, 7, 7, 7], [46, 7, 46, 7, 46], [7, 7, 7, 7, 7]])) call abort()
 286
 287   if (any (reshape (x_tgn%i, [25]) /= [[47, 8, 47, 8, 47], [8, 8, 8, 8, 8],&
 288         [8, 8, 8, 8, 8], [47, 8, 47, 8, 47], [8, 8, 8, 8, 8]])) call abort()
 289 end program finalize_29