1! Test lowering of pointer components
2! RUN: bbc -emit-fir %s -o - | FileCheck %s
3
4module pcomp
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, pointer :: x
33      end subroutine
34      subroutine takes_real_array_pointer(x)
35        real, pointer :: x(:)
36      end subroutine
37      subroutine takes_logical(x)
38        logical :: x
39      end subroutine
40    end interface
41
42    type real_p0
43      real, pointer :: p
44    end type
45    type real_p1
46      real, pointer :: p(:)
47    end type
48    type cst_char_p0
49      character(10), pointer :: p
50    end type
51    type cst_char_p1
52      character(10), pointer :: p(:)
53    end type
54    type def_char_p0
55      character(:), pointer :: p
56    end type
57    type def_char_p1
58      character(:), pointer :: p(:)
59    end type
60    type derived_p0
61      type(t), pointer :: p
62    end type
63    type derived_p1
64      type(t), pointer :: 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
70  contains
71
72  ! -----------------------------------------------------------------------------
73  !            Test pointer component references
74  ! -----------------------------------------------------------------------------
75
76  ! CHECK-LABEL: func @_QMpcompPref_scalar_real_p(
77  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>{{.*}}) {
78  subroutine ref_scalar_real_p(p0_0, p1_0, p0_1, p1_1)
79    type(real_p0) :: p0_0, p0_1(100)
80    type(real_p1) :: p1_0, p1_1(100)
81
82    ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>
83    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>>
84    ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
85    ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
86    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32>
87    ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> ()
88    call takes_real_scalar(p0_0%p)
89
90    ! CHECK: %[[p0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>
91    ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>
92    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>>
93    ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
94    ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
95    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32>
96    ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> ()
97    call takes_real_scalar(p0_1(5)%p)
98
99    ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
100    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
101    ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
102    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
103    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
104    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
105    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32>
106    ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> ()
107    call takes_real_scalar(p1_0%p(7))
108
109    ! CHECK: %[[p1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
110    ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
111    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
112    ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
113    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
114    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
115    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
116    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32>
117    ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> ()
118    call takes_real_scalar(p1_1(5)%p(7))
119  end subroutine
120
121  ! CHECK-LABEL: func @_QMpcompPassign_scalar_real
122  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
123  subroutine assign_scalar_real_p(p0_0, p1_0, p0_1, p1_1)
124    type(real_p0) :: p0_0, p0_1(100)
125    type(real_p1) :: p1_0, p1_1(100)
126    ! CHECK: %[[fld:.*]] = fir.field_index p
127    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
128    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
129    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
130    ! CHECK: fir.store {{.*}} to %[[addr]]
131    p0_0%p = 1.
132
133    ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
134    ! CHECK: %[[fld:.*]] = fir.field_index p
135    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
136    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
137    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
138    ! CHECK: fir.store {{.*}} to %[[addr]]
139    p0_1(5)%p = 2.
140
141    ! CHECK: %[[fld:.*]] = fir.field_index p
142    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
143    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
144    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}}
145    ! CHECK: fir.store {{.*}} to %[[addr]]
146    p1_0%p(7) = 3.
147
148    ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
149    ! CHECK: %[[fld:.*]] = fir.field_index p
150    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
151    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
152    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}}
153    ! CHECK: fir.store {{.*}} to %[[addr]]
154    p1_1(5)%p(7) = 4.
155  end subroutine
156
157  ! CHECK-LABEL: func @_QMpcompPref_scalar_cst_char_p
158  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
159  subroutine ref_scalar_cst_char_p(p0_0, p1_0, p0_1, p1_1)
160    type(cst_char_p0) :: p0_0, p0_1(100)
161    type(cst_char_p1) :: p1_0, p1_1(100)
162
163    ! CHECK: %[[fld:.*]] = fir.field_index p
164    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
165    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
166    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
167    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
168    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
169    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
170    call takes_char_scalar(p0_0%p)
171
172    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
173    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
174    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
175    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
176    ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
177    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
178    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
179    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
180    call takes_char_scalar(p0_1(5)%p)
181
182
183    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
184    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
185    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
186    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
187    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
188    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
189    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
190    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
191    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
192    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
193    call takes_char_scalar(p1_0%p(7))
194
195
196    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
197    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
198    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
199    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
200    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
201    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
202    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
203    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
204    ! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
205    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
206    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
207    call takes_char_scalar(p1_1(5)%p(7))
208
209  end subroutine
210
211  ! CHECK-LABEL: func @_QMpcompPref_scalar_def_char_p
212  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
213  subroutine ref_scalar_def_char_p(p0_0, p1_0, p0_1, p1_1)
214    type(def_char_p0) :: p0_0, p0_1(100)
215    type(def_char_p1) :: p1_0, p1_1(100)
216
217    ! CHECK: %[[fld:.*]] = fir.field_index p
218    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
219    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
220    ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
221    ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
222    ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]]
223    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]]
224    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
225    call takes_char_scalar(p0_0%p)
226
227    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
228    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
229    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
230    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
231    ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
232    ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
233    ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]]
234    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]]
235    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
236    call takes_char_scalar(p0_1(5)%p)
237
238
239    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
240    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
241    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
242    ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
243    ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
244    ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
245    ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
246    ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
247    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
248    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
249    call takes_char_scalar(p1_0%p(7))
250
251
252    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
253    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
254    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
255    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
256    ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
257    ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
258    ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
259    ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
260    ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
261    ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
262    ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
263    call takes_char_scalar(p1_1(5)%p(7))
264
265  end subroutine
266
267  ! CHECK-LABEL: func @_QMpcompPref_scalar_derived
268  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
269  subroutine ref_scalar_derived(p0_0, p1_0, p0_1, p1_1)
270    type(derived_p0) :: p0_0, p0_1(100)
271    type(derived_p1) :: p1_0, p1_1(100)
272
273    ! CHECK: %[[fld:.*]] = fir.field_index p
274    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
275    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
276    ! CHECK: %[[fldx:.*]] = fir.field_index x
277    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
278    ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
279    call takes_real_scalar(p0_0%p%x)
280
281    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
282    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
283    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
284    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
285    ! CHECK: %[[fldx:.*]] = fir.field_index x
286    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
287    ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
288    call takes_real_scalar(p0_1(5)%p%x)
289
290    ! CHECK: %[[fld:.*]] = fir.field_index p
291    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
292    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
293    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
294    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
295    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
296    ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
297    ! CHECK: %[[fldx:.*]] = fir.field_index x
298    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
299    ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
300    call takes_real_scalar(p1_0%p(7)%x)
301
302    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
303    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
304    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
305    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
306    ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
307    ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
308    ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
309    ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
310    ! CHECK: %[[fldx:.*]] = fir.field_index x
311    ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
312    ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
313    call takes_real_scalar(p1_1(5)%p(7)%x)
314
315  end subroutine
316
317  ! -----------------------------------------------------------------------------
318  !            Test passing pointer component references as pointers
319  ! -----------------------------------------------------------------------------
320
321  ! CHECK-LABEL: func @_QMpcompPpass_real_p
322  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
323  subroutine pass_real_p(p0_0, p1_0, p0_1, p1_1)
324    type(real_p0) :: p0_0, p0_1(100)
325    type(real_p1) :: p1_0, p1_1(100)
326    ! CHECK: %[[fld:.*]] = fir.field_index p
327    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
328    ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
329    call takes_real_scalar_pointer(p0_0%p)
330
331    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
332    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
333    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
334    ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
335    call takes_real_scalar_pointer(p0_1(5)%p)
336
337    ! CHECK: %[[fld:.*]] = fir.field_index p
338    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
339    ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
340    call takes_real_array_pointer(p1_0%p)
341
342    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
343    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
344    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
345    ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
346    call takes_real_array_pointer(p1_1(5)%p)
347  end subroutine
348
349  ! -----------------------------------------------------------------------------
350  !            Test usage in intrinsics where pointer aspect matters
351  ! -----------------------------------------------------------------------------
352
353  ! CHECK-LABEL: func @_QMpcompPassociated_p
354  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
355  subroutine associated_p(p0_0, p1_0, p0_1, p1_1)
356    type(real_p0) :: p0_0, p0_1(100)
357    type(def_char_p1) :: p1_0, p1_1(100)
358    ! CHECK: %[[fld:.*]] = fir.field_index p
359    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
360    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
361    ! CHECK: fir.box_addr %[[box]]
362    call takes_logical(associated(p0_0%p))
363
364    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
365    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
366    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
367    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
368    ! CHECK: fir.box_addr %[[box]]
369    call takes_logical(associated(p0_1(5)%p))
370
371    ! CHECK: %[[fld:.*]] = fir.field_index p
372    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
373    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
374    ! CHECK: fir.box_addr %[[box]]
375    call takes_logical(associated(p1_0%p))
376
377    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
378    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
379    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
380    ! CHECK: %[[box:.*]] = fir.load %[[coor]]
381    ! CHECK: fir.box_addr %[[box]]
382    call takes_logical(associated(p1_1(5)%p))
383  end subroutine
384
385  ! -----------------------------------------------------------------------------
386  !            Test pointer assignment of components
387  ! -----------------------------------------------------------------------------
388
389  ! CHECK-LABEL: func @_QMpcompPpassoc_real
390  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
391  subroutine passoc_real(p0_0, p1_0, p0_1, p1_1)
392    type(real_p0) :: p0_0, p0_1(100)
393    type(real_p1) :: p1_0, p1_1(100)
394    ! CHECK: %[[fld:.*]] = fir.field_index p
395    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
396    ! CHECK: fir.store {{.*}} to %[[coor]]
397    p0_0%p => real_target
398
399    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
400    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
401    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
402    ! CHECK: fir.store {{.*}} to %[[coor]]
403    p0_1(5)%p => real_target
404
405    ! CHECK: %[[fld:.*]] = fir.field_index p
406    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
407    ! CHECK: fir.store {{.*}} to %[[coor]]
408    p1_0%p => real_array_target
409
410    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
411    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
412    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
413    ! CHECK: fir.store {{.*}} to %[[coor]]
414    p1_1(5)%p => real_array_target
415  end subroutine
416
417  ! CHECK-LABEL: func @_QMpcompPpassoc_char
418  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
419  subroutine passoc_char(p0_0, p1_0, p0_1, p1_1)
420    type(cst_char_p0) :: p0_0, p0_1(100)
421    type(def_char_p1) :: p1_0, p1_1(100)
422    ! CHECK: %[[fld:.*]] = fir.field_index p
423    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
424    ! CHECK: fir.store {{.*}} to %[[coor]]
425    p0_0%p => char_target
426
427    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
428    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
429    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
430    ! CHECK: fir.store {{.*}} to %[[coor]]
431    p0_1(5)%p => char_target
432
433    ! CHECK: %[[fld:.*]] = fir.field_index p
434    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
435    ! CHECK: fir.store {{.*}} to %[[coor]]
436    p1_0%p => char_array_target
437
438    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
439    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
440    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
441    ! CHECK: fir.store {{.*}} to %[[coor]]
442    p1_1(5)%p => char_array_target
443  end subroutine
444
445  ! -----------------------------------------------------------------------------
446  !            Test nullify of components
447  ! -----------------------------------------------------------------------------
448
449  ! CHECK-LABEL: func @_QMpcompPnullify_test
450  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
451  subroutine nullify_test(p0_0, p1_0, p0_1, p1_1)
452    type(real_p0) :: p0_0, p0_1(100)
453    type(def_char_p1) :: p1_0, p1_1(100)
454    ! CHECK: %[[fld:.*]] = fir.field_index p
455    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
456    ! CHECK: fir.store {{.*}} to %[[coor]]
457    nullify(p0_0%p)
458
459    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
460    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
461    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
462    ! CHECK: fir.store {{.*}} to %[[coor]]
463    nullify(p0_1(5)%p)
464
465    ! CHECK: %[[fld:.*]] = fir.field_index p
466    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
467    ! CHECK: fir.store {{.*}} to %[[coor]]
468    nullify(p1_0%p)
469
470    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
471    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
472    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
473    ! CHECK: fir.store {{.*}} to %[[coor]]
474    nullify(p1_1(5)%p)
475  end subroutine
476
477  ! -----------------------------------------------------------------------------
478  !            Test allocation
479  ! -----------------------------------------------------------------------------
480
481  ! CHECK-LABEL: func @_QMpcompPallocate_real
482  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
483  subroutine allocate_real(p0_0, p1_0, p0_1, p1_1)
484    type(real_p0) :: p0_0, p0_1(100)
485    type(real_p1) :: p1_0, p1_1(100)
486    ! CHECK: %[[fld:.*]] = fir.field_index p
487    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
488    ! CHECK: fir.store {{.*}} to %[[coor]]
489    allocate(p0_0%p)
490
491    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
492    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
493    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
494    ! CHECK: fir.store {{.*}} to %[[coor]]
495    allocate(p0_1(5)%p)
496
497    ! CHECK: %[[fld:.*]] = fir.field_index p
498    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
499    ! CHECK: fir.store {{.*}} to %[[coor]]
500    allocate(p1_0%p(100))
501
502    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
503    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
504    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
505    ! CHECK: fir.store {{.*}} to %[[coor]]
506    allocate(p1_1(5)%p(100))
507  end subroutine
508
509  ! CHECK-LABEL: func @_QMpcompPallocate_cst_char
510  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
511  subroutine allocate_cst_char(p0_0, p1_0, p0_1, p1_1)
512    type(cst_char_p0) :: p0_0, p0_1(100)
513    type(cst_char_p1) :: p1_0, p1_1(100)
514    ! CHECK: %[[fld:.*]] = fir.field_index p
515    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
516    ! CHECK: fir.store {{.*}} to %[[coor]]
517    allocate(p0_0%p)
518
519    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
520    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
521    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
522    ! CHECK: fir.store {{.*}} to %[[coor]]
523    allocate(p0_1(5)%p)
524
525    ! CHECK: %[[fld:.*]] = fir.field_index p
526    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
527    ! CHECK: fir.store {{.*}} to %[[coor]]
528    allocate(p1_0%p(100))
529
530    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
531    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
532    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
533    ! CHECK: fir.store {{.*}} to %[[coor]]
534    allocate(p1_1(5)%p(100))
535  end subroutine
536
537  ! CHECK-LABEL: func @_QMpcompPallocate_def_char
538  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
539  subroutine allocate_def_char(p0_0, p1_0, p0_1, p1_1)
540    type(def_char_p0) :: p0_0, p0_1(100)
541    type(def_char_p1) :: p1_0, p1_1(100)
542    ! CHECK: %[[fld:.*]] = fir.field_index p
543    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
544    ! CHECK: fir.store {{.*}} to %[[coor]]
545    allocate(character(18)::p0_0%p)
546
547    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
548    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
549    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
550    ! CHECK: fir.store {{.*}} to %[[coor]]
551    allocate(character(18)::p0_1(5)%p)
552
553    ! CHECK: %[[fld:.*]] = fir.field_index p
554    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
555    ! CHECK: fir.store {{.*}} to %[[coor]]
556    allocate(character(18)::p1_0%p(100))
557
558    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
559    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
560    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
561    ! CHECK: fir.store {{.*}} to %[[coor]]
562    allocate(character(18)::p1_1(5)%p(100))
563  end subroutine
564
565  ! -----------------------------------------------------------------------------
566  !            Test deallocation
567  ! -----------------------------------------------------------------------------
568
569  ! CHECK-LABEL: func @_QMpcompPdeallocate_real
570  ! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
571  subroutine deallocate_real(p0_0, p1_0, p0_1, p1_1)
572    type(real_p0) :: p0_0, p0_1(100)
573    type(real_p1) :: p1_0, p1_1(100)
574    ! CHECK: %[[fld:.*]] = fir.field_index p
575    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
576    ! CHECK: fir.store {{.*}} to %[[coor]]
577    deallocate(p0_0%p)
578
579    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
580    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
581    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
582    ! CHECK: fir.store {{.*}} to %[[coor]]
583    deallocate(p0_1(5)%p)
584
585    ! CHECK: %[[fld:.*]] = fir.field_index p
586    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
587    ! CHECK: fir.store {{.*}} to %[[coor]]
588    deallocate(p1_0%p)
589
590    ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
591    ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
592    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
593    ! CHECK: fir.store {{.*}} to %[[coor]]
594    deallocate(p1_1(5)%p)
595  end subroutine
596
597  ! -----------------------------------------------------------------------------
598  !            Test a very long component
599  ! -----------------------------------------------------------------------------
600
601  ! CHECK-LABEL: func @_QMpcompPvery_long
602  ! CHECK-SAME: (%[[x:.*]]: {{.*}})
603  subroutine very_long(x)
604    type t0
605      real :: f
606    end type
607    type t1
608      type(t0), allocatable :: e(:)
609    end type
610    type t2
611      type(t1) :: d(10)
612    end type
613    type t3
614      type(t2) :: c
615    end type
616    type t4
617      type(t3), pointer :: b
618    end type
619    type t5
620      type(t4) :: a
621    end type
622    type(t5) :: x(:, :, :, :, :)
623
624    ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[x]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.}}
625    ! CHECK-DAG: %[[flda:.*]] = fir.field_index a
626    ! CHECK-DAG: %[[fldb:.*]] = fir.field_index b
627    ! CHECK: %[[coor1:.*]] = fir.coordinate_of %[[coor0]], %[[flda]], %[[fldb]]
628    ! CHECK: %[[b_box:.*]] = fir.load %[[coor1]]
629    ! CHECK-DAG: %[[fldc:.*]] = fir.field_index c
630    ! CHECK-DAG: %[[fldd:.*]] = fir.field_index d
631    ! CHECK: %[[coor2:.*]] = fir.coordinate_of %[[b_box]], %[[fldc]], %[[fldd]]
632    ! CHECK: %[[index:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
633    ! CHECK: %[[coor3:.*]] = fir.coordinate_of %[[coor2]], %[[index]]
634    ! CHECK: %[[flde:.*]] = fir.field_index e
635    ! CHECK: %[[coor4:.*]] = fir.coordinate_of %[[coor3]], %[[flde]]
636    ! CHECK: %[[e_box:.*]] = fir.load %[[coor4]]
637    ! CHECK: %[[edims:.*]]:3 = fir.box_dims %[[e_box]], %c0{{.*}}
638    ! CHECK: %[[lb:.*]] = fir.convert %[[edims]]#0 : (index) -> i64
639    ! CHECK: %[[index2:.*]] = arith.subi %c7{{.*}}, %[[lb]]
640    ! CHECK: %[[coor5:.*]] = fir.coordinate_of %[[e_box]], %[[index2]]
641    ! CHECK: %[[fldf:.*]] = fir.field_index f
642    ! CHECK: %[[coor6:.*]] = fir.coordinate_of %[[coor5]], %[[fldf:.*]]
643    ! CHECK: fir.load %[[coor6]] : !fir.ref<f32>
644    print *, x(1,2,3,4,5)%a%b%c%d(6)%e(7)%f
645  end subroutine
646
647  ! -----------------------------------------------------------------------------
648  !            Test a recursive derived type reference
649  ! -----------------------------------------------------------------------------
650
651  ! CHECK: func @_QMpcompPtest_recursive
652  ! CHECK-SAME: (%[[x:.*]]: {{.*}})
653  subroutine test_recursive(x)
654    type t
655      integer :: i
656      type(t), pointer :: next
657    end type
658    type(t) :: x
659
660    ! CHECK: %[[fldNext1:.*]] = fir.field_index next
661    ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]]
662    ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]]
663    ! CHECK: %[[fldNext2:.*]] = fir.field_index next
664    ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]]
665    ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]]
666    ! CHECK: %[[fldNext3:.*]] = fir.field_index next
667    ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]]
668    ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]]
669    ! CHECK: %[[fldi:.*]] = fir.field_index i
670    ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]]
671    ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32>
672    print *, x%next%next%next%i
673  end subroutine
674
675  end module
676