1!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
2! Tests for derived type runtime descriptions
3
4module m01
5  type :: t1
6    integer :: n
7  end type
8!CHECK: Module scope: m01
9!CHECK: .c.t1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
10!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
11!CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
12!CHECK: .n.t1, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"t1"
13!CHECK: DerivedType scope: t1
14end module
15
16module m02
17  type :: parent
18    integer :: pn
19  end type
20  type, extends(parent) :: child
21    integer :: cn
22  end type
23!CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
24!CHECK: .c.parent, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
25!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
26!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
27end module
28
29module m03
30  type :: kpdt(k)
31    integer(kind=1), kind :: k = 1
32    real(kind=k) :: a
33  end type
34  type(kpdt(4)) :: x
35!CHECK: .c.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
36!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
37!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
38!CHECK: .kp.kpdt, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::1_8]
39!CHECK: .kp.kpdt.0, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
40end module
41
42module m04
43  type :: tbps
44   contains
45    procedure :: b2 => s1
46    procedure :: b1 => s1
47  end type
48 contains
49  subroutine s1(x)
50    class(tbps), intent(in) :: x
51  end subroutine
52!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
53!CHECK: .v.tbps, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=s1,name=.n.b1),binding(proc=s1,name=.n.b2)]
54end module
55
56module m05
57  type :: t
58    procedure(s1), pointer :: p1 => s1
59  end type
60 contains
61  subroutine s1(x)
62    class(t), intent(in) :: x
63  end subroutine
64!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1)
65!CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
66end module
67
68module m06
69  type :: t
70   contains
71    procedure :: s1
72    generic :: assignment(=) => s1
73  end type
74  type, extends(t) :: t2
75   contains
76    procedure :: s1 => s2 ! override
77  end type
78 contains
79  subroutine s1(x, y)
80    class(t), intent(out) :: x
81    class(t), intent(in) :: y
82  end subroutine
83  subroutine s2(x, y)
84    class(t2), intent(out) :: x
85    class(t), intent(in) :: y
86  end subroutine
87!CHECK: .c.t2, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
88!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
89!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
90!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=4_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
91!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
92!CHECK: .v.t2, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
93end module
94
95module m07
96  type :: t
97   contains
98    procedure :: s1
99    generic :: assignment(=) => s1
100  end type
101 contains
102  impure elemental subroutine s1(x, y)
103    class(t), intent(out) :: x
104    class(t), intent(in) :: y
105  end subroutine
106!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
107!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
108!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
109end module
110
111module m08
112  type :: t
113   contains
114    final :: s1, s2, s3
115  end type
116 contains
117  subroutine s1(x)
118    type(t) :: x(:)
119  end subroutine
120  subroutine s2(x)
121    type(t) :: x(3,3)
122  end subroutine
123  impure elemental subroutine s3(x)
124    type(t) :: x
125  end subroutine
126!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1)
127!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=8_1,rank=1_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=8_1,rank=2_1,isargdescriptorset=0_1,proc=s2),specialbinding(which=9_1,rank=0_1,isargdescriptorset=0_1,proc=s3)]
128end module
129
130module m09
131  type :: t
132   contains
133    procedure :: rf, ru, wf, wu
134    generic :: read(formatted) => rf
135    generic :: read(unformatted) => ru
136    generic :: write(formatted) => wf
137    generic :: write(unformatted) => wu
138  end type
139 contains
140  subroutine rf(x,u,iot,v,iostat,iomsg)
141    class(t), intent(inout) :: x
142    integer, intent(in) :: u
143    character(len=*), intent(in) :: iot
144    integer, intent(in) :: v(:)
145    integer, intent(out) :: iostat
146    character(len=*), intent(inout) :: iomsg
147  end subroutine
148  subroutine ru(x,u,iostat,iomsg)
149    class(t), intent(inout) :: x
150    integer, intent(in) :: u
151    integer, intent(out) :: iostat
152    character(len=*), intent(inout) :: iomsg
153  end subroutine
154  subroutine wf(x,u,iot,v,iostat,iomsg)
155    class(t), intent(in) :: x
156    integer, intent(in) :: u
157    character(len=*), intent(in) :: iot
158    integer, intent(in) :: v(:)
159    integer, intent(out) :: iostat
160    character(len=*), intent(inout) :: iomsg
161  end subroutine
162  subroutine wu(x,u,iostat,iomsg)
163    class(t), intent(in) :: x
164    integer, intent(in) :: u
165    integer, intent(out) :: iostat
166    character(len=*), intent(inout) :: iomsg
167  end subroutine
168!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
169!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=1_1,proc=wu)]
170!CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
171end module
172
173module m10
174  type, bind(c) :: t ! non-extensible
175  end type
176  interface read(formatted)
177    procedure :: rf
178  end interface
179  interface read(unformatted)
180    procedure :: ru
181  end interface
182  interface write(formatted)
183    procedure ::wf
184  end interface
185  interface write(unformatted)
186    procedure :: wu
187  end interface
188 contains
189  subroutine rf(x,u,iot,v,iostat,iomsg)
190    type(t), intent(inout) :: x
191    integer, intent(in) :: u
192    character(len=*), intent(in) :: iot
193    integer, intent(in) :: v(:)
194    integer, intent(out) :: iostat
195    character(len=*), intent(inout) :: iomsg
196  end subroutine
197  subroutine ru(x,u,iostat,iomsg)
198    type(t), intent(inout) :: x
199    integer, intent(in) :: u
200    integer, intent(out) :: iostat
201    character(len=*), intent(inout) :: iomsg
202  end subroutine
203  subroutine wf(x,u,iot,v,iostat,iomsg)
204    type(t), intent(in) :: x
205    integer, intent(in) :: u
206    character(len=*), intent(in) :: iot
207    integer, intent(in) :: v(:)
208    integer, intent(out) :: iostat
209    character(len=*), intent(inout) :: iomsg
210  end subroutine
211  subroutine wu(x,u,iostat,iomsg)
212    type(t), intent(in) :: x
213    integer, intent(in) :: u
214    integer, intent(out) :: iostat
215    character(len=*), intent(inout) :: iomsg
216  end subroutine
217!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
218!CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=0_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=0_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=0_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=0_1,proc=wu)]
219end module
220
221module m11
222  real, target :: target
223  type :: t(len)
224    integer(kind=8), len :: len
225    real, allocatable :: allocatable(:)
226    real, pointer :: pointer => target
227    character(len=len) :: chauto
228    real :: automatic(len)
229  end type
230!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
231!CHECK: .lpk.t, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
232 contains
233  subroutine s1(x)
234!CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
235!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.1.pointer),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
236!CHECK: .di.t.1.pointer, SAVE, TARGET: ObjectEntity type: TYPE(.dp.t.1.pointer) init:.dp.t.1.pointer(pointer=target)
237!CHECK: .dp.t.1.pointer: DerivedType components: pointer
238!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1)
239!CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
240!CHECK: DerivedType scope: .dp.t.1.pointer size=24 alignment=8 instantiation of .dp.t.1.pointer
241!CHECK: pointer, POINTER size=24 offset=0: ObjectEntity type: REAL(4)
242    type(t(*)), intent(in) :: x
243  end subroutine
244end module
245
246module m12
247  type :: t1
248    integer :: n
249    integer :: n2
250    integer :: n_3
251    ! CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
252    ! CHECK: .n.n2, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"n2"
253    ! CHECK: .n.n_3, SAVE, TARGET: ObjectEntity type: CHARACTER(3_8,1) init:"n_3"
254  end type
255end module
256