3 ! Testcase contributed by Andre Vehreschild <vehre@gcc.gnu.org>
5 module module_finalize_29
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
53 final :: tge_scalar_fin, tge_array_fin
59 final :: tgn_scalar_fin, tgn_array_fin
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
67 impure elemental subroutine ten_fin(x)
68 type(ten), intent(inout) :: x
70 ten_fin_counts = ten_fin_counts + 1
71 end subroutine ten_fin
73 impure elemental subroutine tee_fin(x)
74 type(tee), intent(inout) :: x
76 tee_fin_counts = tee_fin_counts + 1
77 end subroutine tee_fin
80 type(tne), intent(inout) :: x
82 tne_fin_counts = tne_fin_counts + 1
83 end subroutine tne_fin
86 type(tnn), intent(inout) :: x
88 tnn_fin_counts = tnn_fin_counts + 1
89 end subroutine tnn_fin
92 type(tae), intent(inout) :: x(:,:)
94 tae_fin_counts = tae_fin_counts + 1
95 end subroutine tae_fin
98 type(tan), intent(inout) :: x(:,:)
100 tan_fin_counts = tan_fin_counts + 1
101 end subroutine tan_fin
103 subroutine tge_scalar_fin(x)
104 type(tge), intent(inout) :: x
106 tge_scalar_fin_counts = tge_scalar_fin_counts + 1
107 end subroutine tge_scalar_fin
109 subroutine tge_array_fin(x)
110 type(tge), intent(inout) :: x(:,:)
112 tge_array_fin_counts = tge_array_fin_counts + 1
113 end subroutine tge_array_fin
115 subroutine tgn_scalar_fin(x)
116 type(tgn), intent(inout) :: x
118 tgn_scalar_fin_counts = tgn_scalar_fin_counts + 1
119 end subroutine tgn_scalar_fin
121 subroutine tgn_array_fin(x)
122 type(tgn), intent(inout) :: x(:,:)
124 tgn_array_fin_counts = tgn_array_fin_counts + 1
125 end subroutine tgn_array_fin
127 ! The finalizer/initializer call producer
128 subroutine ten_init(x)
129 class(ten), intent(out) :: x(:,:)
130 end subroutine ten_init
132 impure elemental subroutine tee_init(x)
133 class(tee), intent(out) :: x
134 end subroutine tee_init
136 impure elemental subroutine tne_init(x)
137 class(tne), intent(out) :: x
138 end subroutine tne_init
140 subroutine tnn_init(x)
141 class(tnn), intent(out) :: x(:,:)
142 end subroutine tnn_init
144 impure elemental subroutine tae_init(x)
145 class(tae), intent(out) :: x
146 end subroutine tae_init
148 subroutine tan_init(x)
149 class(tan), intent(out) :: x(:,:)
150 end subroutine tan_init
152 impure elemental subroutine tge_init(x)
153 class(tge), intent(out) :: x
154 end subroutine tge_init
156 subroutine tgn_init(x)
157 class(tgn), intent(out) :: x(:,:)
158 end subroutine tgn_init
159 end module module_finalize_29
162 use module_finalize_29
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(:,:)
174 ! Set the global counts to zero.
181 tge_scalar_fin_counts = 0
182 tge_array_fin_counts = 0
183 tgn_scalar_fin_counts = 0
184 tgn_array_fin_counts = 0
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))
204 call ten_init(x_ten(::2, ::3))
206 if (ten_fin_counts /= 6) STOP 1
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) STOP 2
212 call tee_init(x_tee(::2, ::3))
214 if (tee_fin_counts /= 6) STOP 3
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) STOP 4
220 call tne_init(x_tne(::2, ::3))
222 if (tne_fin_counts /= 6) STOP 5
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) STOP 6
228 call tnn_init(x_tnn(::2, ::3))
230 if (tnn_fin_counts /= 0) STOP 7
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) STOP 8
235 call tae_init(x_tae(::2, ::3))
237 if (tae_fin_counts /= 0) STOP 9
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) STOP 10
242 call tan_init(x_tan(::2, ::3))
244 if (tan_fin_counts /= 1) STOP 11
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) STOP 12
250 call tge_init(x_tge(::2, ::3))
252 if (tge_scalar_fin_counts /= 6) STOP 13
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) STOP 14
256 tge_scalar_fin_counts = 0
258 call tgn_init(x_tgn(::2, ::3))
260 if (tgn_array_fin_counts /= 1) STOP 15
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) STOP 16
264 tgn_array_fin_counts = 0
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]])) STOP 17
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]])) STOP 18
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]])) STOP 19
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]])) STOP 20
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]])) STOP 21
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]])) STOP 22
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]])) STOP 23
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]])) STOP 24
289 end program finalize_29