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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
! { dg-do run }
!
! Test assumed rank finalizers
!
module finalizable_m
! F2018: 7.5.6.2 para 1: "Otherwise, if there is an elemental final
! subroutine whose dummy argument has the same kind type parameters
! as the entity being finalized, or a final subroutine whose dummy
! argument is assumed-rank with the same kind type parameters as the
! entity being finalized, it is called with the entity as an actual
! argument."
implicit none
type finalizable_t
integer :: component_
contains
final :: finalize
end Type
interface finalizable_type
module procedure construct0, construct1
end interface
integer :: final_ctr = 0
contains
pure function construct0(component) result(finalizable)
integer, intent(in) :: component
type(finalizable_t) finalizable
finalizable%component_ = component
end function
impure function construct1(component) result(finalizable)
integer, intent(in), dimension(:) :: component
type(finalizable_t), dimension(:), allocatable :: finalizable
integer :: sz
sz = size(component)
allocate (finalizable (sz))
finalizable%component_ = component
end function
subroutine finalize(self)
type(finalizable_t), intent(inout), dimension (..) :: self
select rank (self)
rank (0)
print *, "rank 0 value = ", self%component_
rank (1)
print *, "rank 1 value = ", self%component_
rank default
print *, "rank default"
end select
final_ctr = final_ctr + 1
end subroutine
end module
program specification_expression_finalization
use finalizable_m
implicit none
type(finalizable_t) :: a = finalizable_t (1)
type(finalizable_t) :: b(2) = [finalizable_t (2), finalizable_t (3)]
a = finalizable_type (42)
if (final_ctr .ne. 2) stop 1
b = finalizable_type ([42, 43])
print *, b%component_
end program
|
