xref: /llvm-project/flang/test/Semantics/bindings07.f90 (revision 7f7bbc73175d94f63cba905191a4ecc341b9fdba)
1! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
2module ma
3  type a
4   contains
5    procedure, private, nopass :: tbp => sub_a
6    generic :: gen => tbp
7  end type
8  type, extends(a) :: aa
9   contains
10    procedure, private, nopass :: tbp => sub_aa
11  end type
12  type, extends(aa) :: aaa
13   contains
14    procedure, public, nopass :: tbp => sub_aaa
15  end type
16 contains
17  subroutine sub_a(w)
18    character*(*), intent(in) :: w
19    print *, w, ' -> a'
20  end
21  subroutine sub_aa(w)
22    character*(*), intent(in) :: w
23    print *, w, ' -> aa'
24  end
25  subroutine sub_aaa(w)
26    character*(*), intent(in) :: w
27    print *, w, ' -> aaa'
28  end
29  subroutine mono1
30    type(a) :: xa
31    type(aa) :: xaa
32    call xa%tbp('type(a) tbp')
33    call xaa%tbp('type(aa) tbp')
34  end
35  subroutine pa(x, w)
36    class(a), intent(in) :: x
37    character*(*), intent(in) :: w
38    call x%tbp('class(a) ' // w // ' tbp')
39    call x%gen('class(a) ' // w // ' gen')
40  end
41  subroutine pta1
42    call pa(a(), 'a')
43    call pa(aa(), 'aa')
44  end
45  subroutine paa(x, w)
46    class(aa), intent(in) :: x
47    character*(*), intent(in) :: w
48    call x%tbp('class(aa) ' // w // ' tbp')
49    call x%gen('class(aa) ' // w // ' gen')
50  end
51  subroutine ptaa1
52    call paa(aa(), 'aa')
53  end
54  subroutine paaa(x, w)
55    class(aaa), intent(in) :: x
56    character*(*), intent(in) :: w
57    call x%tbp('class(aaa) ' // w // ' tbp')
58    call x%gen('class(aaa) ' // w // ' gen')
59  end
60  subroutine ptaaa1
61    call paaa(aaa(), 'aaa')
62  end
63end
64
65module mb
66  use ma
67  type, extends(a) :: ab
68   contains
69    procedure, public, nopass :: tbp => sub_ab
70  end type
71  type, extends(aa) :: aab
72   contains
73    procedure, public, nopass :: tbp => sub_aab
74  end type
75  type, extends(aaa) :: aaab
76   contains
77    procedure, public, nopass :: tbp => sub_aaab
78  end type
79  type, extends(ab) :: aba
80   contains
81    procedure, public, nopass :: tbp => sub_aba
82  end type
83  type, extends(aab) :: aaba
84   contains
85    procedure, public, nopass :: tbp => sub_aaba
86  end type
87  type, extends(aaab) :: aaaba
88   contains
89    procedure, public, nopass :: tbp => sub_aaaba
90  end type
91 contains
92  subroutine sub_ab(w)
93    character*(*), intent(in) :: w
94    print *, w, ' -> ab'
95  end
96  subroutine sub_aab(w)
97    character*(*), intent(in) :: w
98    print *, w, ' -> aab'
99  end
100  subroutine sub_aaab(w)
101    character*(*), intent(in) :: w
102    print *, w, ' -> aaab'
103  end
104  subroutine sub_aba(w)
105    character*(*), intent(in) :: w
106    print *, w, ' -> aba'
107  end
108  subroutine sub_aaba(w)
109    character*(*), intent(in) :: w
110    print *, w, ' -> aaba'
111  end
112  subroutine sub_aaaba(w)
113    character*(*), intent(in) :: w
114    print *, w, ' -> aaaba'
115  end
116end
117
118module t
119  use mb
120 contains
121  subroutine mono2
122    type(a) :: xa
123    type(aa) :: xaa
124    type(aaa) :: xaaa
125    type(ab) :: xab
126    type(aab) :: xaab
127    type(aaab) :: xaaab
128    type(aba) :: xaba
129    type(aaba) :: xaaba
130    type(aaaba) :: xaaaba
131    call xa%gen('type(a) gen')
132    call xaa%gen('type(aa) gen')
133    call xaaa%tbp('type(aaa) tbp')
134    call xaaa%gen('type(aaa) gen')
135    call xab%tbp('type(ab) tbp')
136    call xab%gen('type(ab) gen')
137    call xaab%tbp('type(aab) tbp')
138    call xaab%gen('type(aab) gen')
139    call xaaab%tbp('type(aaab) tbp')
140    call xaaab%gen('type(aaab) gen')
141    call xaba%tbp('type(aba) tbp')
142    call xaba%gen('type(aba) gen')
143    call xaaba%tbp('type(aaba) tbp')
144    call xaaba%gen('type(aaba) gen')
145    call xaaaba%tbp('type(aaaba) tbp')
146    call xaaaba%gen('type(aaaba) gen')
147  end
148  subroutine pta2
149    call pa(a(), 'a')
150    call pa(aa(), 'aa')
151    call pa(aaa(), 'aaa')
152    call pa(ab(), 'ab')
153    call pa(aab(), 'aab')
154    call pa(aaab(), 'aaab')
155    call pa(aba(), 'aba')
156    call pa(aaba(), 'aaba')
157    call pa(aaaba(), 'aaaba')
158  end
159  subroutine ptaa2
160    call paa(aa(), 'aa')
161    call paa(aaa(), 'aaa')
162    call paa(aab(), 'aab')
163    call paa(aaab(), 'aaab')
164    call paa(aaba(), 'aaba')
165    call paa(aaaba(), 'aaaba')
166  end
167  subroutine ptaaa2
168    call paaa(aaa(), 'aaa')
169    call paaa(aaab(), 'aaab')
170    call paaa(aaaba(), 'aaaba')
171  end
172  subroutine pab(x, w)
173    class(ab), intent(in) :: x
174    character*(*), intent(in) :: w
175    call x%tbp('class(ab) ' // w // ' tbp')
176    call x%gen('class(ab) ' // w // ' gen')
177  end
178  subroutine ptab
179    call pab(ab(), 'ab')
180    call pab(aba(), 'aba')
181  end
182  subroutine paab(x, w)
183    class(aab), intent(in) :: x
184    character*(*), intent(in) :: w
185    call x%tbp('class(aab) ' // w // ' tbp')
186    call x%gen('class(aab) ' // w // ' gen')
187  end
188  subroutine ptaab
189    call pa(aab(), 'aab')
190    call pa(aaba(), 'aaba')
191  end
192  subroutine paaab(x, w)
193    class(aaab), intent(in) :: x
194    character*(*), intent(in) :: w
195    call x%tbp('class(aaab) ' // w // ' tbp')
196    call x%gen('class(aaab) ' // w // ' gen')
197  end
198  subroutine ptaaab
199    call pa(aaab(), 'aaab')
200    call pa(aaaba(), 'aaaba')
201  end
202  subroutine paba(x, w)
203    class(aba), intent(in) :: x
204    character*(*), intent(in) :: w
205    call x%tbp('class(aba) ' // w // ' tbp')
206    call x%gen('class(aba) ' // w // ' gen')
207  end
208  subroutine ptaba
209    call paba(aba(), 'aba')
210  end
211  subroutine paaba(x, w)
212    class(aaba), intent(in) :: x
213    character*(*), intent(in) :: w
214    call x%tbp('class(aaba) ' // w // ' tbp')
215    call x%gen('class(aaba) ' // w // ' gen')
216  end
217  subroutine ptaaba
218    call paaba(aaba(), 'aaba')
219  end
220  subroutine paaaba(x, w)
221    class(aaaba), intent(in) :: x
222    character*(*), intent(in) :: w
223    call x%tbp('class(aaaba) ' // w // ' tbp')
224    call x%gen('class(aaaba) ' // w // ' gen')
225  end
226  subroutine ptaaaba
227    call pa(aaaba(), 'aaaba')
228  end
229end
230
231program main
232  use t
233  call mono1
234  call mono2
235  call pta1
236  call ptaa1
237  call ptaaa1
238  call pta2
239  call ptaa2
240  call ptaaa2
241  call ptab
242  call ptaab
243  call ptaaab
244  call ptaba
245  call ptaaba
246  call ptaaaba
247end
248
249!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)]
250!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)]
251!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)]
252!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)]
253!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)]
254!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)]
255!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)]
256!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)]
257!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)]
258!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_ab numPrivatesNotOverridden: 1
259!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aab numPrivatesNotOverridden: 1
260!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aba numPrivatesNotOverridden: 1
261!CHECK: tbp, NOPASS, PUBLIC: ProcBinding => sub_aaba numPrivatesNotOverridden: 1
262