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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
module ma
type a
contains
procedure, private, nopass :: tbp => sub_a
generic :: gen => tbp
end type
type, extends(a) :: aa
contains
procedure, private, nopass :: tbp => sub_aa
end type
type, extends(aa) :: aaa
contains
procedure, public, nopass :: tbp => sub_aaa
end type
contains
subroutine sub_a(w)
character*(*), intent(in) :: w
print *, w, ' -> a'
end
subroutine sub_aa(w)
character*(*), intent(in) :: w
print *, w, ' -> aa'
end
subroutine sub_aaa(w)
character*(*), intent(in) :: w
print *, w, ' -> aaa'
end
subroutine mono1
type(a) :: xa
type(aa) :: xaa
call xa%tbp('type(a) tbp')
call xaa%tbp('type(aa) tbp')
end
subroutine pa(x, w)
class(a), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(a) ' // w // ' tbp')
call x%gen('class(a) ' // w // ' gen')
end
subroutine pta1
call pa(a(), 'a')
call pa(aa(), 'aa')
end
subroutine paa(x, w)
class(aa), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aa) ' // w // ' tbp')
call x%gen('class(aa) ' // w // ' gen')
end
subroutine ptaa1
call paa(aa(), 'aa')
end
subroutine paaa(x, w)
class(aaa), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aaa) ' // w // ' tbp')
call x%gen('class(aaa) ' // w // ' gen')
end
subroutine ptaaa1
call paaa(aaa(), 'aaa')
end
end
module mb
use ma
type, extends(a) :: ab
contains
procedure, public, nopass :: tbp => sub_ab
end type
type, extends(aa) :: aab
contains
procedure, public, nopass :: tbp => sub_aab
end type
type, extends(aaa) :: aaab
contains
procedure, public, nopass :: tbp => sub_aaab
end type
type, extends(ab) :: aba
contains
procedure, public, nopass :: tbp => sub_aba
end type
type, extends(aab) :: aaba
contains
procedure, public, nopass :: tbp => sub_aaba
end type
type, extends(aaab) :: aaaba
contains
procedure, public, nopass :: tbp => sub_aaaba
end type
contains
subroutine sub_ab(w)
character*(*), intent(in) :: w
print *, w, ' -> ab'
end
subroutine sub_aab(w)
character*(*), intent(in) :: w
print *, w, ' -> aab'
end
subroutine sub_aaab(w)
character*(*), intent(in) :: w
print *, w, ' -> aaab'
end
subroutine sub_aba(w)
character*(*), intent(in) :: w
print *, w, ' -> aba'
end
subroutine sub_aaba(w)
character*(*), intent(in) :: w
print *, w, ' -> aaba'
end
subroutine sub_aaaba(w)
character*(*), intent(in) :: w
print *, w, ' -> aaaba'
end
end
module t
use mb
contains
subroutine mono2
type(a) :: xa
type(aa) :: xaa
type(aaa) :: xaaa
type(ab) :: xab
type(aab) :: xaab
type(aaab) :: xaaab
type(aba) :: xaba
type(aaba) :: xaaba
type(aaaba) :: xaaaba
call xa%gen('type(a) gen')
call xaa%gen('type(aa) gen')
call xaaa%tbp('type(aaa) tbp')
call xaaa%gen('type(aaa) gen')
call xab%tbp('type(ab) tbp')
call xab%gen('type(ab) gen')
call xaab%tbp('type(aab) tbp')
call xaab%gen('type(aab) gen')
call xaaab%tbp('type(aaab) tbp')
call xaaab%gen('type(aaab) gen')
call xaba%tbp('type(aba) tbp')
call xaba%gen('type(aba) gen')
call xaaba%tbp('type(aaba) tbp')
call xaaba%gen('type(aaba) gen')
call xaaaba%tbp('type(aaaba) tbp')
call xaaaba%gen('type(aaaba) gen')
end
subroutine pta2
call pa(a(), 'a')
call pa(aa(), 'aa')
call pa(aaa(), 'aaa')
call pa(ab(), 'ab')
call pa(aab(), 'aab')
call pa(aaab(), 'aaab')
call pa(aba(), 'aba')
call pa(aaba(), 'aaba')
call pa(aaaba(), 'aaaba')
end
subroutine ptaa2
call paa(aa(), 'aa')
call paa(aaa(), 'aaa')
call paa(aab(), 'aab')
call paa(aaab(), 'aaab')
call paa(aaba(), 'aaba')
call paa(aaaba(), 'aaaba')
end
subroutine ptaaa2
call paaa(aaa(), 'aaa')
call paaa(aaab(), 'aaab')
call paaa(aaaba(), 'aaaba')
end
subroutine pab(x, w)
class(ab), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(ab) ' // w // ' tbp')
call x%gen('class(ab) ' // w // ' gen')
end
subroutine ptab
call pab(ab(), 'ab')
call pab(aba(), 'aba')
end
subroutine paab(x, w)
class(aab), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aab) ' // w // ' tbp')
call x%gen('class(aab) ' // w // ' gen')
end
subroutine ptaab
call pa(aab(), 'aab')
call pa(aaba(), 'aaba')
end
subroutine paaab(x, w)
class(aaab), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aaab) ' // w // ' tbp')
call x%gen('class(aaab) ' // w // ' gen')
end
subroutine ptaaab
call pa(aaab(), 'aaab')
call pa(aaaba(), 'aaaba')
end
subroutine paba(x, w)
class(aba), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aba) ' // w // ' tbp')
call x%gen('class(aba) ' // w // ' gen')
end
subroutine ptaba
call paba(aba(), 'aba')
end
subroutine paaba(x, w)
class(aaba), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aaba) ' // w // ' tbp')
call x%gen('class(aaba) ' // w // ' gen')
end
subroutine ptaaba
call paaba(aaba(), 'aaba')
end
subroutine paaaba(x, w)
class(aaaba), intent(in) :: x
character*(*), intent(in) :: w
call x%tbp('class(aaaba) ' // w // ' tbp')
call x%gen('class(aaaba) ' // w // ' gen')
end
subroutine ptaaaba
call pa(aaaba(), 'aaaba')
end
end
program main
use t
call mono1
call mono2
call pta1
call ptaa1
call ptaaa1
call pta2
call ptaa2
call ptaaa2
call ptab
call ptaab
call ptaaab
call ptaba
call ptaaba
call ptaaaba
end
!CHECK: .v.a, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_a,name=.n.tbp)]
!CHECK: .v.aa, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aa,name=.n.tbp)]
!CHECK: .v.aaa, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaa,name=.n.tbp)]
!CHECK: .v.aaab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaab,name=.n.tbp)]
!CHECK: .v.aaaba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=sub_aaaba,name=.n.tbp)]
!CHECK: .v.aab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_aa,name=.n.tbp),binding(proc=sub_aab,name=.n.tbp)]
!CHECK: .v.aaba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_aa,name=.n.tbp),binding(proc=sub_aaba,name=.n.tbp)]
!CHECK: .v.ab, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_a,name=.n.tbp),binding(proc=sub_ab,name=.n.tbp)]
!CHECK: .v.aba, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=sub_a,name=.n.tbp),binding(proc=sub_aba,name=.n.tbp)]
!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_ab numPrivatesNotOverridden: 1
!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aab numPrivatesNotOverridden: 1
!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aba numPrivatesNotOverridden: 1
!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aaba numPrivatesNotOverridden: 1
|
