blob: dd6d953b40c458d142d5723189f811b2c9cb1a97 (
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
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
71
72
73
74
|
! { dg-do compile }
!
! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
module sub_m
type :: sub_t
private
integer :: val
end type
interface sub_t
module procedure constructor
end interface
interface sub_t_val
module procedure t_val
end interface
contains
function constructor(val) result(sub)
integer, intent(in) :: val
type(sub_t) :: sub
sub%val = val
end function
function t_val(val) result(res)
integer :: res
type(sub_t), intent(in) :: val
res = val%val
end function
end module
module obj_m
use sub_m, only: sub_t
type :: obj_t
private
type(sub_t) :: sub_obj_
contains
procedure :: sub_obj
end type
interface obj_t
module procedure constructor
end interface
contains
function constructor(sub_obj) result(obj)
type(sub_t), intent(in) :: sub_obj
type(obj_t) :: obj
obj%sub_obj_ = sub_obj
end function
function sub_obj(self)
class(obj_t), intent(in) :: self
type(sub_t) :: sub_obj
sub_obj = self%sub_obj_
end function
end module
program main
use sub_m, only: sub_t, sub_t_val
use obj_m, only: obj_t
type(sub_t), allocatable :: z
associate(initial_sub => sub_t(42))
associate(obj => obj_t(initial_sub))
associate(sub_obj => obj%sub_obj())
allocate (z, source = obj%sub_obj())
end associate
end associate
end associate
if (sub_t_val (z) .ne. 42) stop 1
end program
|
