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
|
module bar_type
implicit none
private
public :: bar_destroy
type, public :: bar
integer :: v = 0
contains
final :: bar_destroy
end type bar
interface bar_destroy
module procedure bar_destroy
end interface bar_destroy
contains
subroutine bar_destroy(this)
type(bar), intent(inout) :: this
this%v = -1
end subroutine
end module bar_type
module foo_type
implicit none
type :: foo
contains
procedure :: f
end type
contains
subroutine f(this, x)
use bar_type, only: bar
class(foo), intent(in) :: this
type(bar), intent(in) :: x
print *, "foo%f called, x%v =", x%v
if (x%v /= 42) error stop
end subroutine
end module foo_type
program class_81
use foo_type
use bar_type
implicit none
type(foo) :: a
type(bar) :: b
b%v = 42
print *, "Before call: b%v =", b%v
if (b%v /= 42) error stop
call a%f(b)
print *, "After call: b%v =", b%v
if (b%v /= 42) error stop
end program class_81
|
