blob: cf85f1398e18538ba058f381bb65d14caa8a5935 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
! { dg-do run }
!
! Test that PR67471 is fixed. Used not to call the finalizer.
!
! Contributed by Ian Harvey <ian_harvey@bigpond.com>
!
module test_final_mod
implicit none
type :: my_final
integer :: n = 1
contains
final :: destroy_scalar, destroy_rank1_array
end type my_final
integer :: final_calls = 0
contains
subroutine destroy_rank1_array(self)
type(my_final), intent(inout) :: self(:)
if (size(self) /= 0) then
if (size(self) /= 2) stop 1
if (any (self%n /= [3,4])) stop 2
else
stop 3
end if
final_calls = final_calls + 1
end subroutine destroy_rank1_array
! Eliminate the warning about the lack of a scalar finalizer.
subroutine destroy_scalar(self)
type(my_final), intent(inout) :: self
final_calls = final_calls + self%n
end subroutine destroy_scalar
end module test_final_mod
program test_finalizer
use test_final_mod
implicit none
type(my_final) :: b(4), c(2)
b%n = [2, 3, 4, 5]
c%n = [6, 7]
b(2:3) = c
if (final_calls /= 1) stop 4
end program test_finalizer
|
