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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
! { dg-do run }
! Tests the fix for PR41648 in which the reference a%a%getit () was wrongly
! identified as a recursive call to getit.
!
! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
!
module foo_mod
type foo
integer :: i
contains
procedure, pass(a) :: doit
procedure, pass(a) :: getit
end type foo
private doit,getit
contains
subroutine doit(a)
class(foo) :: a
a%i = 1
end subroutine doit
function getit(a) result(res)
class(foo) :: a
integer :: res
res = a%i
end function getit
end module foo_mod
module s_bar_mod
use foo_mod
type, extends(foo) :: s_bar
type(foo), allocatable :: a
contains
procedure, pass(a) :: doit
procedure, pass(a) :: getit
end type s_bar
private doit,getit
contains
subroutine doit(a)
class(s_bar) :: a
allocate (a%a)
call a%a%doit()
end subroutine doit
function getit(a) result(res)
class(s_bar) :: a
integer :: res
res = a%a%getit () * 2
end function getit
end module s_bar_mod
module a_bar_mod
use foo_mod
type, extends(foo) :: a_bar
type(foo), allocatable :: a(:)
contains
procedure, pass(a) :: doit
procedure, pass(a) :: getit
end type a_bar
private doit,getit
contains
subroutine doit(a)
class(a_bar) :: a
allocate (a%a(1))
call a%a(1)%doit ()
end subroutine doit
function getit(a) result(res)
class(a_bar) :: a
integer :: res
res = a%a(1)%getit () * 3
end function getit
end module a_bar_mod
use s_bar_mod
use a_bar_mod
type(foo), target :: b
type(s_bar), target :: c
type(a_bar), target :: d
class(foo), pointer :: a
a => b
call a%doit
if (a%getit () .ne. 1) call abort
a => c
call a%doit
if (a%getit () .ne. 2) call abort
a => d
call a%doit
if (a%getit () .ne. 3) call abort
end
|
