xref: /llvm-project/flang/test/Lower/derived-allocatable-components.f90 (revision f35f863a88f83332bef9605ef4cfe4f05c066efb)
1! Test lowering of allocatable components
2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
3
4module acomp
5  implicit none
6  type t
7    real :: x
8    integer :: i
9  end type
10  interface
11    subroutine takes_real_scalar(x)
12      real :: x
13    end subroutine
14    subroutine takes_char_scalar(x)
15      character(*) :: x
16    end subroutine
17    subroutine takes_derived_scalar(x)
18      import t
19      type(t) :: x
20    end subroutine
21    subroutine takes_real_array(x)
22      real :: x(:)
23    end subroutine
24    subroutine takes_char_array(x)
25      character(*) :: x(:)
26    end subroutine
27    subroutine takes_derived_array(x)
28      import t
29      type(t) :: x(:)
30    end subroutine
31    subroutine takes_real_scalar_pointer(x)
32      real, allocatable :: x
33    end subroutine
34    subroutine takes_real_array_pointer(x)
35      real, allocatable :: x(:)
36    end subroutine
37    subroutine takes_logical(x)
38      logical :: x
39    end subroutine
40  end interface
41
42  type real_a0
43    real, allocatable :: p
44  end type
45  type real_a1
46    real, allocatable :: p(:)
47  end type
48  type cst_char_a0
49    character(10), allocatable :: p
50  end type
51  type cst_char_a1
52    character(10), allocatable :: p(:)
53  end type
54  type def_char_a0
55    character(:), allocatable :: p
56  end type
57  type def_char_a1
58    character(:), allocatable :: p(:)
59  end type
60  type derived_a0
61    type(t), allocatable :: p
62  end type
63  type derived_a1
64    type(t), allocatable :: p(:)
65  end type
66
67  real, target :: real_target, real_array_target(100)
68  character(10), target :: char_target, char_array_target(100)
69
70contains
71
72! -----------------------------------------------------------------------------
73!            Test allocatable component references
74! -----------------------------------------------------------------------------
75
76! CHECK-LABEL: func @_QMacompPref_scalar_real_a(
77! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}) {
78subroutine ref_scalar_real_a(a0_0, a1_0, a0_1, a1_1)
79  type(real_a0) :: a0_0, a0_1(100)
80  type(real_a1) :: a1_0, a1_1(100)
81
82  ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>
83  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<f32>>>
84  ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<f32>>>
85  ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
86  ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap<f32>) -> !fir.ref<f32>
87  ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) {{.*}}: (!fir.ref<f32>) -> ()
88  call takes_real_scalar(a0_0%p)
89
90  ! CHECK: %[[a0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>
91  ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>
92  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<f32>>>
93  ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<f32>>>
94  ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
95  ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap<f32>) -> !fir.ref<f32>
96  ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) {{.*}}: (!fir.ref<f32>) -> ()
97  call takes_real_scalar(a0_1(5)%p)
98
99  ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
100  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
101  ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
102  ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
103  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
104  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
105  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
106  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
107  ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) {{.*}}: (!fir.ref<f32>) -> ()
108  call takes_real_scalar(a1_0%p(7))
109
110  ! CHECK: %[[a1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
111  ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
112  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
113  ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
114  ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
115  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
116  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
117  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
118  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
119  ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) {{.*}}: (!fir.ref<f32>) -> ()
120  call takes_real_scalar(a1_1(5)%p(7))
121end subroutine
122
123! CHECK-LABEL: func @_QMacompPref_array_real_a(
124! CHECK-SAME:        %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}) {
125! CHECK:         %[[VAL_2:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
126! CHECK:         %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
127! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
128! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
129! CHECK:         %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
130! CHECK:         %[[VAL_7:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
131! CHECK:         %[[VAL_8:.*]] = arith.constant 20 : i64
132! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
133! CHECK:         %[[VAL_10:.*]] = arith.constant 2 : i64
134! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
135! CHECK:         %[[VAL_12:.*]] = arith.constant 50 : i64
136! CHECK:         %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> index
137! CHECK:         %[[VAL_14:.*]] = fir.shape_shift %[[VAL_6]]#0, %[[VAL_6]]#1 : (index, index) -> !fir.shapeshift<1>
138! CHECK:         %[[VAL_15:.*]] = fir.slice %[[VAL_9]], %[[VAL_13]], %[[VAL_11]] : (index, index, index) -> !fir.slice<1>
139! CHECK:         %[[VAL_16:.*]] = fir.embox %[[VAL_7]](%[[VAL_14]]) {{\[}}%[[VAL_15]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<16xf32>>
140! CHECK:         %[[VAL_16_NEW:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.array<16xf32>>) -> !fir.box<!fir.array<?xf32>>
141! CHECK:         fir.call @_QPtakes_real_array(%[[VAL_16_NEW]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
142! CHECK:         %[[VAL_17:.*]] = arith.constant 5 : i64
143! CHECK:         %[[VAL_18:.*]] = arith.constant 1 : i64
144! CHECK:         %[[VAL_19:.*]] = arith.subi %[[VAL_17]], %[[VAL_18]] : i64
145! CHECK:         %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_19]] : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
146! CHECK:         %[[VAL_21:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
147! CHECK:         %[[VAL_22:.*]] = fir.coordinate_of %[[VAL_20]], %[[VAL_21]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
148! CHECK:         %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
149! CHECK:         %[[VAL_24:.*]] = arith.constant 0 : index
150! CHECK:         %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_24]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
151! CHECK:         %[[VAL_26:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
152! CHECK:         %[[VAL_27:.*]] = arith.constant 20 : i64
153! CHECK:         %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index
154! CHECK:         %[[VAL_29:.*]] = arith.constant 2 : i64
155! CHECK:         %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i64) -> index
156! CHECK:         %[[VAL_31:.*]] = arith.constant 50 : i64
157! CHECK:         %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i64) -> index
158! CHECK:         %[[VAL_33:.*]] = fir.shape_shift %[[VAL_25]]#0, %[[VAL_25]]#1 : (index, index) -> !fir.shapeshift<1>
159! CHECK:         %[[VAL_34:.*]] = fir.slice %[[VAL_28]], %[[VAL_32]], %[[VAL_30]] : (index, index, index) -> !fir.slice<1>
160! CHECK:         %[[VAL_35:.*]] = fir.embox %[[VAL_26]](%[[VAL_33]]) {{\[}}%[[VAL_34]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<16xf32>>
161! CHECK:         %[[VAL_35_NEW:.*]] = fir.convert %[[VAL_35]] : (!fir.box<!fir.array<16xf32>>) -> !fir.box<!fir.array<?xf32>>
162! CHECK:         fir.call @_QPtakes_real_array(%[[VAL_35_NEW]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
163! CHECK:         return
164! CHECK:       }
165
166subroutine ref_array_real_a(a1_0, a1_1)
167  type(real_a1) :: a1_0, a1_1(100)
168  call takes_real_array(a1_0%p(20:50:2))
169  call takes_real_array(a1_1(5)%p(20:50:2))
170end subroutine
171
172! CHECK-LABEL: func @_QMacompPref_scalar_cst_char_a
173! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
174subroutine ref_scalar_cst_char_a(a0_0, a1_0, a0_1, a1_1)
175  type(cst_char_a0) :: a0_0, a0_1(100)
176  type(cst_char_a1) :: a1_0, a1_1(100)
177
178  ! CHECK: %[[fld:.*]] = fir.field_index p
179  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
180  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
181  ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
182  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
183  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
184  call takes_char_scalar(a0_0%p)
185
186  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
187  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
188  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
189  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
190  ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
191  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
192  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
193  call takes_char_scalar(a0_1(5)%p)
194
195
196  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
197  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
198  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
199  ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
200  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
201  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
202  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
203  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]]
204  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
205  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
206  call takes_char_scalar(a1_0%p(7))
207
208
209  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
210  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
211  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
212  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
213  ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
214  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
215  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
216  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
217  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]]
218  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
219  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
220  call takes_char_scalar(a1_1(5)%p(7))
221
222end subroutine
223
224! CHECK-LABEL: func @_QMacompPref_scalar_def_char_a
225! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
226subroutine ref_scalar_def_char_a(a0_0, a1_0, a0_1, a1_1)
227  type(def_char_a0) :: a0_0, a0_1(100)
228  type(def_char_a1) :: a1_0, a1_1(100)
229
230  ! CHECK: %[[fld:.*]] = fir.field_index p
231  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
232  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
233  ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
234  ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
235  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
236  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
237  call takes_char_scalar(a0_0%p)
238
239  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
240  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
241  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
242  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
243  ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
244  ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
245  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
246  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
247  call takes_char_scalar(a0_1(5)%p)
248
249
250  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
251  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
252  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
253  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
254  ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
255  ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
256  ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
257  ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index
258  ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index
259  ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index
260  ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index
261  ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]]
262  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]]
263  ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]]
264  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]]
265  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
266  call takes_char_scalar(a1_0%p(7))
267
268
269  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
270  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
271  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
272  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
273  ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
274  ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
275  ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
276  ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
277  ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index
278  ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index
279  ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index
280  ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index
281  ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]]
282  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]]
283  ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]]
284  ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]]
285  ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
286  call takes_char_scalar(a1_1(5)%p(7))
287
288end subroutine
289
290! CHECK-LABEL: func @_QMacompPref_scalar_derived
291! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
292subroutine ref_scalar_derived(a0_0, a1_0, a0_1, a1_1)
293  type(derived_a0) :: a0_0, a0_1(100)
294  type(derived_a1) :: a1_0, a1_1(100)
295
296  ! CHECK: %[[fld:.*]] = fir.field_index p
297  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
298  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
299  ! CHECK: %[[fldx:.*]] = fir.field_index x
300  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
301  ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
302  call takes_real_scalar(a0_0%p%x)
303
304  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
305  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
306  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
307  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
308  ! CHECK: %[[fldx:.*]] = fir.field_index x
309  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
310  ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
311  call takes_real_scalar(a0_1(5)%p%x)
312
313  ! CHECK: %[[fld:.*]] = fir.field_index p
314  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
315  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
316  ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
317  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
318  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
319  ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
320  ! CHECK: %[[fldx:.*]] = fir.field_index x
321  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
322  ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
323  call takes_real_scalar(a1_0%p(7)%x)
324
325  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
326  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
327  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
328  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
329  ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
330  ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
331  ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
332  ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
333  ! CHECK: %[[fldx:.*]] = fir.field_index x
334  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
335  ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
336  call takes_real_scalar(a1_1(5)%p(7)%x)
337
338end subroutine
339
340! -----------------------------------------------------------------------------
341!            Test passing allocatable component references as allocatables
342! -----------------------------------------------------------------------------
343
344! CHECK-LABEL: func @_QMacompPpass_real_a
345! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
346subroutine pass_real_a(a0_0, a1_0, a0_1, a1_1)
347  type(real_a0) :: a0_0, a0_1(100)
348  type(real_a1) :: a1_0, a1_1(100)
349  ! CHECK: %[[fld:.*]] = fir.field_index p
350  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
351  ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
352  call takes_real_scalar_pointer(a0_0%p)
353
354  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
355  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
356  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
357  ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
358  call takes_real_scalar_pointer(a0_1(5)%p)
359
360  ! CHECK: %[[fld:.*]] = fir.field_index p
361  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
362  ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
363  call takes_real_array_pointer(a1_0%p)
364
365  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
366  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
367  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
368  ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
369  call takes_real_array_pointer(a1_1(5)%p)
370end subroutine
371
372! -----------------------------------------------------------------------------
373!            Test usage in intrinsics where pointer aspect matters
374! -----------------------------------------------------------------------------
375
376! CHECK-LABEL: func @_QMacompPallocated_p
377! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
378subroutine allocated_p(a0_0, a1_0, a0_1, a1_1)
379  type(real_a0) :: a0_0, a0_1(100)
380  type(def_char_a1) :: a1_0, a1_1(100)
381  ! CHECK: %[[fld:.*]] = fir.field_index p
382  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
383  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
384  ! CHECK: fir.box_addr %[[box]]
385  call takes_logical(allocated(a0_0%p))
386
387  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
388  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
389  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
390  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
391  ! CHECK: fir.box_addr %[[box]]
392  call takes_logical(allocated(a0_1(5)%p))
393
394  ! CHECK: %[[fld:.*]] = fir.field_index p
395  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
396  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
397  ! CHECK: fir.box_addr %[[box]]
398  call takes_logical(allocated(a1_0%p))
399
400  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
401  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
402  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
403  ! CHECK: %[[box:.*]] = fir.load %[[coor]]
404  ! CHECK: fir.box_addr %[[box]]
405  call takes_logical(allocated(a1_1(5)%p))
406end subroutine
407
408! -----------------------------------------------------------------------------
409!            Test allocation
410! -----------------------------------------------------------------------------
411
412! CHECK-LABEL: func @_QMacompPallocate_real
413! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
414subroutine allocate_real(a0_0, a1_0, a0_1, a1_1)
415  type(real_a0) :: a0_0, a0_1(100)
416  type(real_a1) :: a1_0, a1_1(100)
417  ! CHECK: %[[fld:.*]] = fir.field_index p
418  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
419  ! CHECK: fir.store {{.*}} to %[[coor]]
420  allocate(a0_0%p)
421
422  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
423  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
424  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
425  ! CHECK: fir.store {{.*}} to %[[coor]]
426  allocate(a0_1(5)%p)
427
428  ! CHECK: %[[fld:.*]] = fir.field_index p
429  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
430  ! CHECK: fir.store {{.*}} to %[[coor]]
431  allocate(a1_0%p(100))
432
433  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
434  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
435  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
436  ! CHECK: fir.store {{.*}} to %[[coor]]
437  allocate(a1_1(5)%p(100))
438end subroutine
439
440! CHECK-LABEL: func @_QMacompPallocate_cst_char
441! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
442subroutine allocate_cst_char(a0_0, a1_0, a0_1, a1_1)
443  type(cst_char_a0) :: a0_0, a0_1(100)
444  type(cst_char_a1) :: a1_0, a1_1(100)
445  ! CHECK: %[[fld:.*]] = fir.field_index p
446  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
447  ! CHECK: fir.store {{.*}} to %[[coor]]
448  allocate(a0_0%p)
449
450  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
451  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
452  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
453  ! CHECK: fir.store {{.*}} to %[[coor]]
454  allocate(a0_1(5)%p)
455
456  ! CHECK: %[[fld:.*]] = fir.field_index p
457  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
458  ! CHECK: fir.store {{.*}} to %[[coor]]
459  allocate(a1_0%p(100))
460
461  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
462  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
463  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
464  ! CHECK: fir.store {{.*}} to %[[coor]]
465  allocate(a1_1(5)%p(100))
466end subroutine
467
468! CHECK-LABEL: func @_QMacompPallocate_def_char
469! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
470subroutine allocate_def_char(a0_0, a1_0, a0_1, a1_1)
471  type(def_char_a0) :: a0_0, a0_1(100)
472  type(def_char_a1) :: a1_0, a1_1(100)
473  ! CHECK: %[[fld:.*]] = fir.field_index p
474  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
475  ! CHECK: fir.store {{.*}} to %[[coor]]
476  allocate(character(18)::a0_0%p)
477
478  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
479  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
480  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
481  ! CHECK: fir.store {{.*}} to %[[coor]]
482  allocate(character(18)::a0_1(5)%p)
483
484  ! CHECK: %[[fld:.*]] = fir.field_index p
485  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
486  ! CHECK: fir.store {{.*}} to %[[coor]]
487  allocate(character(18)::a1_0%p(100))
488
489  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
490  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
491  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
492  ! CHECK: fir.store {{.*}} to %[[coor]]
493  allocate(character(18)::a1_1(5)%p(100))
494end subroutine
495
496! -----------------------------------------------------------------------------
497!            Test deallocation
498! -----------------------------------------------------------------------------
499
500! CHECK-LABEL: func @_QMacompPdeallocate_real
501! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
502subroutine deallocate_real(a0_0, a1_0, a0_1, a1_1)
503  type(real_a0) :: a0_0, a0_1(100)
504  type(real_a1) :: a1_0, a1_1(100)
505  ! CHECK: %[[fld:.*]] = fir.field_index p
506  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
507  ! CHECK: fir.store {{.*}} to %[[coor]]
508  deallocate(a0_0%p)
509
510  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
511  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
512  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
513  ! CHECK: fir.store {{.*}} to %[[coor]]
514  deallocate(a0_1(5)%p)
515
516  ! CHECK: %[[fld:.*]] = fir.field_index p
517  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
518  ! CHECK: fir.store {{.*}} to %[[coor]]
519  deallocate(a1_0%p)
520
521  ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
522  ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
523  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
524  ! CHECK: fir.store {{.*}} to %[[coor]]
525  deallocate(a1_1(5)%p)
526end subroutine
527
528! -----------------------------------------------------------------------------
529!            Test a recursive derived type reference
530! -----------------------------------------------------------------------------
531
532! CHECK: func @_QMacompPtest_recursive
533! CHECK-SAME: (%[[x:.*]]: {{.*}})
534subroutine test_recursive(x)
535  type t
536    integer :: i
537    type(t), allocatable :: next
538  end type
539  type(t) :: x
540
541  ! CHECK: %[[fldNext1:.*]] = fir.field_index next
542  ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]]
543  ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]]
544  ! CHECK: %[[fldNext2:.*]] = fir.field_index next
545  ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]]
546  ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]]
547  ! CHECK: %[[fldNext3:.*]] = fir.field_index next
548  ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]]
549  ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]]
550  ! CHECK: %[[fldi:.*]] = fir.field_index i
551  ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]]
552  ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32>
553  print *, x%next%next%next%i
554end subroutine
555
556end module
557