1! Test basic parts of derived type entities lowering
2! RUN: bbc -emit-fir %s -o - | FileCheck %s
3
4! Note: only testing non parameterized derived type here.
5
6module d
7  type r
8    real :: x
9  end type
10  type r2
11    real :: x_array(10, 20)
12  end type
13  type c
14    character(10) :: ch
15  end type
16  type c2
17    character(10) :: ch_array(20, 30)
18  end type
19contains
20
21! -----------------------------------------------------------------------------
22!            Test simple derived type symbol lowering
23! -----------------------------------------------------------------------------
24
25! CHECK-LABEL: func @_QMdPderived_dummy(
26! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMdTr{x:f32}>>{{.*}}, %{{.*}}: !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>{{.*}}) {
27subroutine derived_dummy(some_r, some_c2)
28  type(r) :: some_r
29  type(c2) :: some_c2
30end subroutine
31
32! CHECK-LABEL: func @_QMdPlocal_derived(
33subroutine local_derived()
34  ! CHECK-DAG: fir.alloca !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
35  ! CHECK-DAG: fir.alloca !fir.type<_QMdTr{x:f32}>
36  type(r) :: some_r
37  type(c2) :: some_c2
38end subroutine
39
40! CHECK-LABEL: func @_QMdPsaved_derived(
41subroutine saved_derived()
42  ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_c2) : !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>
43  ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_r) : !fir.ref<!fir.type<_QMdTr{x:f32}>>
44  type(r), save :: some_r
45  type(c2), save :: some_c2
46  call use_symbols(some_r, some_c2)
47end subroutine
48
49
50! -----------------------------------------------------------------------------
51!            Test simple derived type references
52! -----------------------------------------------------------------------------
53
54! CHECK-LABEL: func @_QMdPscalar_numeric_ref(
55subroutine scalar_numeric_ref()
56  ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
57  type(r) :: some_r
58  ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
59  ! CHECK: fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
60  call real_bar(some_r%x)
61end subroutine
62
63! CHECK-LABEL: func @_QMdPscalar_character_ref(
64subroutine scalar_character_ref()
65  ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTc{ch:!fir.char<1,10>}>
66  type(c) :: some_c
67  ! CHECK: %[[field:.*]] = fir.field_index ch, !fir.type<_QMdTc{ch:!fir.char<1,10>}>
68  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>>
69  ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : index
70  ! CHECK-DAG: %[[conv:.*]] = fir.convert %[[coor]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
71  ! CHECK: fir.emboxchar %[[conv]], %c10 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
72  call char_bar(some_c%ch)
73end subroutine
74
75! FIXME: coordinate of generated for derived%array_comp(i) are not zero based as they
76! should be.
77
78! CHECK-LABEL: func @_QMdParray_comp_elt_ref(
79subroutine array_comp_elt_ref()
80  type(r2) :: some_r2
81  ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>
82  ! CHECK: %[[field:.*]] = fir.field_index x_array, !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>
83  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>>, !fir.field) -> !fir.ref<!fir.array<10x20xf32>>
84  ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
85  ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
86  ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<10x20xf32>>, i64, i64) -> !fir.ref<f32>
87  call real_bar(some_r2%x_array(5, 6))
88end subroutine
89
90
91! CHECK-LABEL: func @_QMdPchar_array_comp_elt_ref(
92subroutine char_array_comp_elt_ref()
93  type(c2) :: some_c2
94  ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>, !fir.field) -> !fir.ref<!fir.array<20x30x!fir.char<1,10>>>
95  ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
96  ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
97  ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<20x30x!fir.char<1,10>>>, i64, i64) -> !fir.ref<!fir.char<1,10>>
98  ! CHECK: fir.emboxchar %{{.*}}, %c10 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
99  call char_bar(some_c2%ch_array(5, 6))
100end subroutine
101
102! CHECK: @_QMdParray_elt_comp_ref
103subroutine array_elt_comp_ref()
104  type(r) :: some_r_array(100)
105  ! CHECK: %[[alloca:.*]] = fir.alloca !fir.array<100x!fir.type<_QMdTr{x:f32}>>
106  ! CHECK: %[[index:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
107  ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[alloca]], %[[index]] : (!fir.ref<!fir.array<100x!fir.type<_QMdTr{x:f32}>>>, i64) -> !fir.ref<!fir.type<_QMdTr{x:f32}>>
108  ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
109  ! CHECK: fir.coordinate_of %[[elt]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
110  call real_bar(some_r_array(5)%x)
111end subroutine
112
113! CHECK: @_QMdPchar_array_elt_comp_ref
114subroutine char_array_elt_comp_ref()
115  type(c) :: some_c_array(100)
116  ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMdTc{ch:!fir.char<1,10>}>>>, i64) -> !fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>
117  ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>>
118  ! CHECK: fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
119  call char_bar(some_c_array(5)%ch)
120end subroutine
121
122! -----------------------------------------------------------------------------
123!            Test loading derived type components
124! -----------------------------------------------------------------------------
125
126! Most of the other tests only require lowering code to compute the address of
127! components. This one requires loading a component which tests other code paths
128! in lowering.
129
130! CHECK-LABEL: func @_QMdPscalar_numeric_load(
131! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMdTr{x:f32}>>
132real function scalar_numeric_load(some_r)
133  type(r) :: some_r
134  ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
135  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
136  ! CHECK: fir.load %[[coor]]
137  scalar_numeric_load = some_r%x
138end function
139
140! -----------------------------------------------------------------------------
141!            Test returned derived types (no length parameters)
142! -----------------------------------------------------------------------------
143
144! CHECK-LABEL: func @_QMdPbar_return_derived() -> !fir.type<_QMdTr{x:f32}>
145function bar_return_derived()
146  ! CHECK: %[[res:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
147  type(r) :: bar_return_derived
148  ! CHECK: %[[resLoad:.*]] = fir.load %[[res]] : !fir.ref<!fir.type<_QMdTr{x:f32}>>
149  ! CHECK: return %[[resLoad]] : !fir.type<_QMdTr{x:f32}>
150end function
151
152! CHECK-LABEL: func @_QMdPcall_bar_return_derived(
153subroutine call_bar_return_derived()
154  ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
155  ! CHECK: %[[call:.*]] = fir.call @_QMdPbar_return_derived() : () -> !fir.type<_QMdTr{x:f32}>
156  ! CHECK: fir.save_result %[[call]] to %[[tmp]] : !fir.type<_QMdTr{x:f32}>, !fir.ref<!fir.type<_QMdTr{x:f32}>>
157  ! CHECK: fir.call @_QPr_bar(%[[tmp]]) : (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> ()
158  call r_bar(bar_return_derived())
159end subroutine
160
161end module
162
163! -----------------------------------------------------------------------------
164!            Test derived type with pointer/allocatable components
165! -----------------------------------------------------------------------------
166
167module d2
168  type recursive_t
169    real :: x
170    type(recursive_t), pointer :: ptr
171  end type
172contains
173! CHECK-LABEL: func @_QMd2Ptest_recursive_type(
174! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMd2Trecursive_t{x:f32,ptr:!fir.box<!fir.ptr<!fir.type<_QMd2Trecursive_t>>>}>>{{.*}}) {
175subroutine test_recursive_type(some_recursive)
176  type(recursive_t) :: some_recursive
177end subroutine
178end module
179
180! -----------------------------------------------------------------------------
181!            Test global derived type symbol lowering
182! -----------------------------------------------------------------------------
183
184module data_mod
185  use d
186  type(r) :: some_r
187  type(c2) :: some_c2
188end module
189
190! Test globals
191
192! CHECK-DAG: fir.global @_QMdata_modEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
193! CHECK-DAG: fir.global @_QMdata_modEsome_r : !fir.type<_QMdTr{x:f32}>
194! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
195! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_r : !fir.type<_QMdTr{x:f32}>
196