xref: /llvm-project/flang/test/Lower/host-associated.f90 (revision a88677edc0792534ba3157bf7d7a1b98e470f2fb) 
1! Test internal procedure host association lowering.
2! RUN: bbc -hlfir=false -fwrapv %s -o - | FileCheck %s
3
4! -----------------------------------------------------------------------------
5!     Test non character intrinsic scalars
6! -----------------------------------------------------------------------------
7
8!!! Test scalar (with implicit none)
9
10! CHECK-LABEL: func @_QPtest1(
11subroutine test1
12  implicit none
13  integer i
14  ! CHECK-DAG: %[[i:.*]] = fir.alloca i32 {{.*}}uniq_name = "_QFtest1Ei"
15  ! CHECK-DAG: %[[tup:.*]] = fir.alloca tuple<!fir.ref<i32>>
16  ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[tup]], %c0
17  ! CHECK: fir.store %[[i]] to %[[addr]] : !fir.llvm_ptr<!fir.ref<i32>>
18  ! CHECK: fir.call @_QFtest1Ptest1_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
19  call test1_internal
20  print *, i
21contains
22  ! CHECK-LABEL: func private @_QFtest1Ptest1_internal(
23  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
24  ! CHECK: %[[iaddr:.*]] = fir.coordinate_of %[[arg]], %c0
25  ! CHECK: %[[i:.*]] = fir.load %[[iaddr]] : !fir.llvm_ptr<!fir.ref<i32>>
26  ! CHECK: %[[val:.*]] = fir.call @_QPifoo() {{.*}}: () -> i32
27  ! CHECK: fir.store %[[val]] to %[[i]] : !fir.ref<i32>
28  subroutine test1_internal
29    integer, external :: ifoo
30    i = ifoo()
31  end subroutine test1_internal
32end subroutine test1
33
34!!! Test scalar
35
36! CHECK-LABEL: func @_QPtest2() {
37subroutine test2
38  a = 1.0
39  b = 2.0
40  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<f32>, !fir.ref<f32>>
41  ! CHECK: %[[a0:.*]] = fir.coordinate_of %[[tup]], %c0
42  ! CHECK: fir.store %{{.*}} to %[[a0]] : !fir.llvm_ptr<!fir.ref<f32>>
43  ! CHECK: %[[b0:.*]] = fir.coordinate_of %[[tup]], %c1
44  ! CHECK: fir.store %{{.*}} to %[[b0]] : !fir.llvm_ptr<!fir.ref<f32>>
45  ! CHECK: fir.call @_QFtest2Ptest2_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>>) -> ()
46  call test2_internal
47  print *, a, b
48contains
49  ! CHECK-LABEL: func private @_QFtest2Ptest2_internal(
50  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
51  subroutine test2_internal
52    ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c0
53    ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>
54    ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c1
55    ! CHECK: %{{.*}} = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>
56    ! CHECK: fir.alloca
57    ! CHECK: fir.load %[[aa]] : !fir.ref<f32>
58    c = a
59    a = b
60    b = c
61    call test2_inner
62  end subroutine test2_internal
63
64  ! CHECK-LABEL: func private @_QFtest2Ptest2_inner(
65  ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
66  subroutine test2_inner
67    ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c0
68    ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>
69    ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c1
70    ! CHECK: %[[bb:.*]] = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>
71    ! CHECK-DAG: %[[bd:.*]] = fir.load %[[bb]] : !fir.ref<f32>
72    ! CHECK-DAG: %[[ad:.*]] = fir.load %[[aa]] : !fir.ref<f32>
73    ! CHECK: %{{.*}} = arith.cmpf ogt, %[[ad]], %[[bd]] {{.*}} : f32
74    if (a > b) then
75       b = b + 2.0
76    end if
77  end subroutine test2_inner
78end subroutine test2
79
80! -----------------------------------------------------------------------------
81!     Test non character scalars
82! -----------------------------------------------------------------------------
83
84! CHECK-LABEL: func @_QPtest6(
85! CHECK-SAME: %[[c:.*]]: !fir.boxchar<1>
86subroutine test6(c)
87  character(*) :: c
88  ! CHECK: %[[cunbox:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
89  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.boxchar<1>>
90  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
91  ! CHECK: %[[emboxchar:.*]] = fir.emboxchar %[[cunbox]]#0, %[[cunbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
92  ! CHECK: fir.store %[[emboxchar]] to %[[coor]] : !fir.ref<!fir.boxchar<1>>
93  ! CHECK: fir.call @_QFtest6Ptest6_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.boxchar<1>>>) -> ()
94  call test6_inner
95  print *, c
96
97contains
98  ! CHECK-LABEL: func private @_QFtest6Ptest6_inner(
99  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
100  subroutine test6_inner
101    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
102    ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.boxchar<1>>
103    ! CHECK: fir.unboxchar %[[load]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
104    c = "Hi there"
105  end subroutine test6_inner
106end subroutine test6
107
108! -----------------------------------------------------------------------------
109!     Test non allocatable and pointer arrays
110! -----------------------------------------------------------------------------
111
112! CHECK-LABEL: func @_QPtest3(
113! CHECK-SAME: %[[p:[^:]+]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[q:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[i:.*]]: !fir.ref<i64>
114subroutine test3(p,q,i)
115  integer(8) :: i
116  real :: p(i:)
117  real :: q(:)
118  ! CHECK: %[[iload:.*]] = fir.load %[[i]] : !fir.ref<i64>
119  ! CHECK: %[[icast:.*]] = fir.convert %[[iload]] : (i64) -> index
120  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>
121  ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
122  ! CHECK: %[[pshift:.*]] = fir.shift %[[icast]] : (index) -> !fir.shift<1>
123  ! CHECK: %[[pbox:.*]] = fir.rebox %[[p]](%[[pshift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>
124  ! CHECK: fir.store %[[pbox]] to %[[ptup]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
125  ! CHECK: %[[qtup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
126  ! CHECK: %[[qbox:.*]] = fir.rebox %[[q]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
127  ! CHECK: fir.store %[[qbox]] to %[[qtup]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
128
129  i = i + 1
130  q = -42.0
131
132  ! CHECK: fir.call @_QFtest3Ptest3_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>) -> ()
133  call test3_inner
134
135  if (p(2) .ne. -42.0) then
136     print *, "failed"
137  end if
138
139contains
140  ! CHECK-LABEL: func private @_QFtest3Ptest3_inner(
141  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
142  subroutine test3_inner
143    ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
144    ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
145    ! CHECK: %[[pbounds:.]]:3 = fir.box_dims %[[p]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
146    ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
147    ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
148    ! CHECK: %[[qbounds:.]]:3 = fir.box_dims %[[q]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
149
150
151    ! CHECK: %[[qlb:.*]] = fir.convert %[[qbounds]]#0 : (index) -> i64
152    ! CHECK: %[[qoffset:.*]] = arith.subi %c1{{.*}}, %[[qlb]] : i64
153    ! CHECK: %[[qelt:.*]] = fir.coordinate_of %[[q]], %[[qoffset]] : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
154    ! CHECK: %[[qload:.*]] = fir.load %[[qelt]] : !fir.ref<f32>
155    ! CHECK: %[[plb:.*]] = fir.convert %[[pbounds]]#0 : (index) -> i64
156    ! CHECK: %[[poffset:.*]] = arith.subi %c2{{.*}}, %[[plb]] : i64
157    ! CHECK: %[[pelt:.*]] = fir.coordinate_of %[[p]], %[[poffset]] : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
158    ! CHECK: fir.store %[[qload]] to %[[pelt]] : !fir.ref<f32>
159    p(2) = q(1)
160  end subroutine test3_inner
161end subroutine test3
162
163! CHECK-LABEL: func @_QPtest3a(
164! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.array<10xf32>>{{.*}}) {
165subroutine test3a(p)
166  real :: p(10)
167  real :: q(10)
168  ! CHECK: %[[q:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "q", uniq_name = "_QFtest3aEq"}
169  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>
170  ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
171  ! CHECK: %[[shape:.*]] = fir.shape %c10{{.*}} : (index) -> !fir.shape<1>
172  ! CHECK: %[[pbox:.*]] = fir.embox %[[p]](%[[shape]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
173  ! CHECK: fir.store %[[pbox]] to %[[ptup]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
174  ! CHECK: %[[qtup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
175  ! CHECK: %[[qbox:.*]] = fir.embox %[[q]](%[[shape]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
176  ! CHECK: fir.store %[[qbox]] to %[[qtup]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
177
178  q = -42.0
179  ! CHECK: fir.call @_QFtest3aPtest3a_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>) -> ()
180  call test3a_inner
181
182  if (p(1) .ne. -42.0) then
183     print *, "failed"
184  end if
185
186contains
187  ! CHECK: func private @_QFtest3aPtest3a_inner(
188  ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
189  subroutine test3a_inner
190    ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
191    ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
192    ! CHECK: %[[paddr:.*]] = fir.box_addr %[[p]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>
193    ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>
194    ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>
195    ! CHECK: %[[qaddr:.*]] = fir.box_addr %[[q]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>
196
197    ! CHECK: %[[qelt:.*]] = fir.coordinate_of %[[qaddr]], %c0{{.*}} : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
198    ! CHECK: %[[qload:.*]] = fir.load %[[qelt]] : !fir.ref<f32>
199    ! CHECK: %[[pelt:.*]] = fir.coordinate_of %[[paddr]], %c0{{.*}} : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
200    ! CHECK: fir.store %[[qload]] to %[[pelt]] : !fir.ref<f32>
201    p(1) = q(1)
202  end subroutine test3a_inner
203end subroutine test3a
204
205! -----------------------------------------------------------------------------
206!     Test allocatable and pointer scalars
207! -----------------------------------------------------------------------------
208
209! CHECK-LABEL: func @_QPtest4() {
210subroutine test4
211  real, pointer :: p
212  real, allocatable, target :: ally
213  ! CHECK: %[[ally:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "ally", fir.target, uniq_name = "_QFtest4Eally"}
214  ! CHECK: %[[p:.*]] = fir.alloca !fir.box<!fir.ptr<f32>> {bindc_name = "p", uniq_name = "_QFtest4Ep"}
215  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>
216  ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
217  ! CHECK: fir.store %[[p]] to %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
218  ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
219  ! CHECK: fir.store %[[ally]] to %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
220  ! CHECK: fir.call @_QFtest4Ptest4_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>) -> ()
221
222  allocate(ally)
223  ally = -42.0
224  call test4_inner
225
226  if (p .ne. -42.0) then
227     print *, "failed"
228  end if
229
230contains
231  ! CHECK-LABEL: func private @_QFtest4Ptest4_inner(
232  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
233  subroutine test4_inner
234    ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
235    ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>
236    ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
237    ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>
238    ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<f32>>>
239    ! CHECK: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
240    ! CHECK: %[[ptr:.*]] = fir.embox %[[addr]] : (!fir.heap<f32>) -> !fir.box<!fir.ptr<f32>>
241    ! CHECK: fir.store %[[ptr]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
242    p => ally
243  end subroutine test4_inner
244end subroutine test4
245
246! -----------------------------------------------------------------------------
247!     Test allocatable and pointer arrays
248! -----------------------------------------------------------------------------
249
250! CHECK-LABEL: func @_QPtest5() {
251subroutine test5
252  real, pointer :: p(:)
253  real, allocatable, target :: ally(:)
254
255  ! CHECK: %[[ally:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "ally", fir.target
256  ! CHECK: %[[p:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p"
257  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
258  ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
259  ! CHECK: fir.store %[[p]] to %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
260  ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
261  ! CHECK: fir.store %[[ally]] to %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
262  ! CHECK: fir.call @_QFtest5Ptest5_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>) -> ()
263
264  allocate(ally(10))
265  ally = -42.0
266  call test5_inner
267
268  if (p(1) .ne. -42.0) then
269     print *, "failed"
270  end if
271
272contains
273  ! CHECK-LABEL: func private @_QFtest5Ptest5_inner(
274  ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
275  subroutine test5_inner
276    ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
277    ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>
278    ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
279    ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>
280    ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
281    ! CHECK-DAG: %[[adims:.*]]:3 = fir.box_dims %[[abox]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
282    ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
283    ! CHECK-DAG: %[[ashape:.*]] = fir.shape_shift %[[adims]]#0, %[[adims]]#1 : (index, index) -> !fir.shapeshift<1>
284
285    ! CHECK: %[[ptr:.*]] = fir.embox %[[addr]](%[[ashape]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
286    ! CHECK: fir.store %[[ptr]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
287    p => ally
288  end subroutine test5_inner
289end subroutine test5
290
291
292! -----------------------------------------------------------------------------
293!     Test elemental internal procedure
294! -----------------------------------------------------------------------------
295
296! CHECK-LABEL: func @_QPtest7(
297! CHECK-SAME: %[[j:.*]]: !fir.ref<i32>{{.*}}, %[[k:.*]]: !fir.box<!fir.array<?xi32>>
298subroutine test7(j, k)
299  implicit none
300  integer :: j
301  integer :: k(:)
302  ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<i32>>
303  ! CHECK: %[[jtup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
304  ! CHECK: fir.store %[[j]] to %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>
305
306  ! CHECK: %[[kelem:.*]] = fir.array_coor %[[k]] %{{.*}} : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
307  ! CHECK: fir.call @_QFtest7Ptest7_inner(%[[kelem]], %[[tup]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> i32
308  k = test7_inner(k)
309contains
310
311! CHECK-LABEL: func private @_QFtest7Ptest7_inner(
312! CHECK-SAME: %[[i:.*]]: !fir.ref<i32>{{.*}}, %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) -> i32 attributes {fir.host_symbol = {{.*}}, fir.proc_attrs = #fir.proc_attrs<elemental, pure>, llvm.linkage = #llvm.linkage<internal>} {
313elemental integer function test7_inner(i)
314  implicit none
315  integer, intent(in) :: i
316  ! CHECK: %[[jtup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
317  ! CHECK: %[[jptr:.*]] = fir.load %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>
318  ! CHECK-DAG: %[[iload:.*]] = fir.load %[[i]] : !fir.ref<i32>
319  ! CHECK-DAG: %[[jload:.*]] = fir.load %[[jptr]] : !fir.ref<i32>
320  ! CHECK: addi %[[iload]], %[[jload]] : i32
321  test7_inner = i + j
322end function
323end subroutine
324
325subroutine issue990()
326  ! Test that host symbols used in statement functions inside an internal
327  ! procedure are correctly captured from the host.
328  implicit none
329  integer :: captured
330  call bar()
331contains
332! CHECK-LABEL: func private @_QFissue990Pbar(
333! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
334subroutine bar()
335  integer :: stmt_func, i
336  stmt_func(i) = i + captured
337  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
338  ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>
339  ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>
340  ! CHECK: arith.addi %{{.*}}, %[[value]] : i32
341  print *, stmt_func(10)
342end subroutine
343end subroutine
344
345subroutine issue990b()
346  ! Test when an internal procedure uses a statement function from its host
347  ! which uses host variables that are otherwise not used by the internal
348  ! procedure.
349  implicit none
350  integer :: captured, captured_stmt_func, i
351  captured_stmt_func(i) = i + captured
352  call bar()
353contains
354! CHECK-LABEL: func private @_QFissue990bPbar(
355! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
356subroutine bar()
357  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
358  ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>
359  ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>
360  ! CHECK: arith.addi %{{.*}}, %[[value]] : i32
361  print *, captured_stmt_func(10)
362end subroutine
363end subroutine
364
365! Test capture of dummy procedure functions.
366subroutine test8(dummy_proc)
367 implicit none
368 interface
369   real function dummy_proc(x)
370    real :: x
371   end function
372 end interface
373 call bar()
374contains
375! CHECK-LABEL: func private @_QFtest8Pbar(
376! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
377subroutine bar()
378  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>
379  ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>
380  ! CHECK: %[[dummyProcCast:.*]] = fir.box_addr %[[dummyProc]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> f32)
381  ! CHECK: fir.call %[[dummyProcCast]](%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32
382 print *, dummy_proc(42.)
383end subroutine
384end subroutine
385
386! Test capture of dummy subroutines.
387subroutine test9(dummy_proc)
388 implicit none
389 interface
390   subroutine dummy_proc()
391   end subroutine
392 end interface
393 call bar()
394contains
395! CHECK-LABEL: func private @_QFtest9Pbar(
396! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
397subroutine bar()
398  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>
399  ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>
400  ! CHECK: %[[pa:.*]] = fir.box_addr %[[dummyProc]]
401  ! CHECK: fir.call %[[pa]]() {{.*}}: () -> ()
402  call dummy_proc()
403end subroutine
404end subroutine
405
406! Test capture of namelist
407! CHECK-LABEL: func @_QPtest10(
408! CHECK-SAME: %[[i:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>{{.*}}) {
409subroutine test10(i)
410 implicit none
411 integer, pointer :: i(:)
412 namelist /a_namelist/ i
413 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup:.*]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
414 ! CHECK: fir.store %[[i]] to %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
415 ! CHECK: fir.call @_QFtest10Pbar(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>) -> ()
416 call bar()
417contains
418! CHECK-LABEL: func private @_QFtest10Pbar(
419! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
420subroutine bar()
421  ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
422  ! CHECK: fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>
423  read (88, NML = a_namelist)
424end subroutine
425end subroutine
426
427! Test passing an internal procedure as a dummy argument.
428
429! CHECK-LABEL: func @_QPtest_proc_dummy() {
430! CHECK:         %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFtest_proc_dummyEi"}
431! CHECK:         %[[VAL_5:.*]] = fir.alloca tuple<!fir.ref<i32>>
432! CHECK:         %[[VAL_7:.*]] = fir.address_of(@_QFtest_proc_dummyPtest_proc_dummy_a) : (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()
433! CHECK:         %[[VAL_8:.*]] = fir.emboxproc %[[VAL_7]], %[[VAL_5]] : ((!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> (), !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
434! CHECK:         fir.call @_QPtest_proc_dummy_other(%[[VAL_8]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
435
436! CHECK-LABEL: func private @_QFtest_proc_dummyPtest_proc_dummy_a(
437! CHECK-SAME:          %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "j"},
438! CHECK-SAME:          %[[VAL_1:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
439! CHECK:         %[[VAL_2:.*]] = arith.constant 0 : i32
440! CHECK:         %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
441! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
442! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
443! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
444! CHECK:         %[[VAL_7:.*]] = arith.addi %[[VAL_5]], %[[VAL_6]] : i32
445! CHECK:         fir.store %[[VAL_7]] to %[[VAL_4]] : !fir.ref<i32>
446! CHECK:         return
447! CHECK:       }
448
449! CHECK-LABEL: func @_QPtest_proc_dummy_other(
450! CHECK-SAME:           %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
451! CHECK:         %[[VAL_1:.*]] = arith.constant 4 : i32
452! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref}
453! CHECK:         fir.store %[[VAL_1]] to %[[VAL_2]] : !fir.ref<i32>
454! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i32>) -> ())
455! CHECK:         fir.call %[[VAL_3]](%[[VAL_2]]) {{.*}}: (!fir.ref<i32>) -> ()
456! CHECK:         return
457! CHECK:       }
458
459subroutine test_proc_dummy
460  integer i
461  i = 1
462  call test_proc_dummy_other(test_proc_dummy_a)
463  print *, i
464contains
465  subroutine test_proc_dummy_a(j)
466    i = i + j
467  end subroutine test_proc_dummy_a
468end subroutine test_proc_dummy
469
470subroutine test_proc_dummy_other(proc)
471  call proc(4)
472end subroutine test_proc_dummy_other
473
474! CHECK-LABEL: func @_QPtest_proc_dummy_char() {
475! CHECK-DAG:         %[[VAL_0:.*]] = arith.constant 10 : index
476! CHECK-DAG:         %[[VAL_1:.*]] = arith.constant 0 : i32
477! CHECK-DAG:         %[[VAL_2:.*]] = arith.constant 9 : index
478! CHECK-DAG:         %[[VAL_3:.*]] = arith.constant false
479! CHECK-DAG:         %[[VAL_4:.*]] = arith.constant 1 : index
480! CHECK-DAG:         %[[VAL_5:.*]] = arith.constant 32 : i8
481! CHECK-DAG:         %[[VAL_6:.*]] = arith.constant 6 : i32
482! CHECK-DAG:         %[[VAL_8:.*]] = arith.constant 10 : i64
483! CHECK-DAG:         %[[VAL_9:.*]] = arith.constant 40 : index
484! CHECK-DAG:         %[[VAL_10:.*]] = arith.constant 0 : index
485! CHECK:         %[[VAL_11:.*]] = fir.alloca !fir.char<1,40> {bindc_name = ".result"}
486! CHECK:         %[[VAL_12:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "message", uniq_name = "_QFtest_proc_dummy_charEmessage"}
487! CHECK:         %[[VAL_13:.*]] = fir.alloca tuple<!fir.boxchar<1>>
488! CHECK:         %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_13]], %[[VAL_1]] : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
489! CHECK:         %[[VAL_16:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
490! CHECK:         fir.store %[[VAL_16]] to %[[VAL_14]] : !fir.ref<!fir.boxchar<1>>
491! CHECK:         %[[VAL_17:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,9>>
492! CHECK:         %[[VAL_18:.*]] = fir.convert %[[VAL_2]] : (index) -> i64
493! CHECK:         %[[VAL_19:.*]] = fir.convert %[[VAL_12]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
494! CHECK:         %[[VAL_20:.*]] = fir.convert %[[VAL_17]] : (!fir.ref<!fir.char<1,9>>) -> !fir.ref<i8>
495! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_19]], %[[VAL_20]], %[[VAL_18]], %[[VAL_3]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
496! CHECK:         %[[VAL_21:.*]] = fir.undefined !fir.char<1>
497! CHECK:         %[[VAL_22:.*]] = fir.insert_value %[[VAL_21]], %[[VAL_5]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
498! CHECK:         br ^bb1(%[[VAL_2]], %[[VAL_4]] : index, index)
499! CHECK:       ^bb1(%[[VAL_23:.*]]: index, %[[VAL_24:.*]]: index):
500! CHECK:         %[[VAL_25:.*]] = arith.cmpi sgt, %[[VAL_24]], %[[VAL_10]] : index
501! CHECK:         cond_br %[[VAL_25]], ^bb2, ^bb3
502! CHECK:       ^bb2:
503! CHECK:         %[[VAL_26:.*]] = fir.convert %[[VAL_12]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>
504! CHECK:         %[[VAL_27:.*]] = fir.coordinate_of %[[VAL_26]], %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
505! CHECK:         fir.store %[[VAL_22]] to %[[VAL_27]] : !fir.ref<!fir.char<1>>
506! CHECK:         %[[VAL_28:.*]] = arith.addi %[[VAL_23]], %[[VAL_4]] : index
507! CHECK:         %[[VAL_29:.*]] = arith.subi %[[VAL_24]], %[[VAL_4]] : index
508! CHECK:         br ^bb1(%[[VAL_28]], %[[VAL_29]] : index, index)
509! CHECK:       ^bb3:
510! CHECK:         %[[VAL_30:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,
511! CHECK:         %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
512! CHECK:         %[[VAL_32:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_6]], %[[VAL_31]], %{{.*}}) {{.*}}: (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
513! CHECK:         %[[VAL_33:.*]] = fir.address_of(@_QFtest_proc_dummy_charPgen_message) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxchar<1>
514! CHECK:         %[[VAL_34:.*]] = fir.emboxproc %[[VAL_33]], %[[VAL_13]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxchar<1>, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxproc<() -> ()>
515! CHECK:         %[[VAL_35:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
516! CHECK:         %[[VAL_36:.*]] = fir.insert_value %[[VAL_35]], %[[VAL_34]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
517! CHECK:         %[[VAL_37:.*]] = fir.insert_value %[[VAL_36]], %[[VAL_8]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
518! CHECK:         %[[VAL_38:.*]] = llvm.intr.stacksave : !llvm.ptr
519! CHECK:         %[[VAL_39:.*]] = fir.call @_QPget_message(%[[VAL_11]], %[[VAL_9]], %[[VAL_37]]) {{.*}}: (!fir.ref<!fir.char<1,40>>, index, tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxchar<1>
520! CHECK:         %[[VAL_40:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<i8>
521! CHECK:         %[[VAL_41:.*]] = fir.convert %[[VAL_9]] : (index) -> i64
522! CHECK:         %[[VAL_42:.*]] = fir.call @_FortranAioOutputAscii(%[[VAL_32]], %[[VAL_40]], %[[VAL_41]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
523! CHECK:         llvm.intr.stackrestore %[[VAL_38]] : !llvm.ptr
524! CHECK:         %[[VAL_43:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_32]]) {{.*}}: (!fir.ref<i8>) -> i32
525! CHECK:         return
526! CHECK:       }
527
528! CHECK-LABEL: func private @_QFtest_proc_dummy_charPgen_message(
529! CHECK-SAME:                                            %[[VAL_0:.*]]: !fir.ref<!fir.char<1,10>>,
530! CHECK-SAME:                                            %[[VAL_1:.*]]: index,
531! CHECK-SAME:                                            %[[VAL_2:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) -> !fir.boxchar<1> attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
532! CHECK-DAG:         %[[VAL_3:.*]] = arith.constant 0 : i32
533! CHECK-DAG:         %[[VAL_4:.*]] = arith.constant 10 : index
534! CHECK-DAG:         %[[VAL_5:.*]] = arith.constant false
535! CHECK-DAG:         %[[VAL_6:.*]] = arith.constant 1 : index
536! CHECK-DAG:         %[[VAL_7:.*]] = arith.constant 32 : i8
537! CHECK-DAG:         %[[VAL_8:.*]] = arith.constant 0 : index
538! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
539! CHECK:         %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref<!fir.boxchar<1>>
540! CHECK:         %[[VAL_11:.*]]:2 = fir.unboxchar %[[VAL_10]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
541! CHECK:         %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]]#1, %[[VAL_4]] : index
542! CHECK:         %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_4]], %[[VAL_11]]#1 : index
543! CHECK:         %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (index) -> i64
544! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
545! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_11]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
546! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]], %[[VAL_5]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
547! CHECK:         %[[VAL_18:.*]] = fir.undefined !fir.char<1>
548! CHECK:         %[[VAL_19:.*]] = fir.insert_value %[[VAL_18]], %[[VAL_7]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
549! CHECK:         %[[VAL_20:.*]] = arith.subi %[[VAL_4]], %[[VAL_14]] : index
550! CHECK:         br ^bb1(%[[VAL_14]], %[[VAL_20]] : index, index)
551! CHECK:       ^bb1(%[[VAL_21:.*]]: index, %[[VAL_22:.*]]: index):
552! CHECK:         %[[VAL_23:.*]] = arith.cmpi sgt, %[[VAL_22]], %[[VAL_8]] : index
553! CHECK:         cond_br %[[VAL_23]], ^bb2, ^bb3
554! CHECK:       ^bb2:
555! CHECK:         %[[VAL_24:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>
556! CHECK:         %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_24]], %[[VAL_21]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
557! CHECK:         fir.store %[[VAL_19]] to %[[VAL_25]] : !fir.ref<!fir.char<1>>
558! CHECK:         %[[VAL_26:.*]] = arith.addi %[[VAL_21]], %[[VAL_6]] : index
559! CHECK:         %[[VAL_27:.*]] = arith.subi %[[VAL_22]], %[[VAL_6]] : index
560! CHECK:         br ^bb1(%[[VAL_26]], %[[VAL_27]] : index, index)
561! CHECK:       ^bb3:
562! CHECK:         %[[VAL_28:.*]] = fir.emboxchar %[[VAL_0]], %[[VAL_4]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
563! CHECK:         return %[[VAL_28]] : !fir.boxchar<1>
564! CHECK:       }
565
566! CHECK-LABEL: func @_QPget_message(
567! CHECK-SAME:                       %[[VAL_0:.*]]: !fir.ref<!fir.char<1,40>>,
568! CHECK-SAME:                       %[[VAL_1:.*]]: index,
569! CHECK-SAME:                       %[[VAL_2:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) -> !fir.boxchar<1> {
570! CHECK-DAG:     %[[VAL_3:.*]] = arith.constant 40 : index
571! CHECK-DAG:     %[[VAL_4:.*]] = arith.constant 12 : index
572! CHECK-DAG:     %[[VAL_5:.*]] = arith.constant false
573! CHECK-DAG:     %[[VAL_6:.*]] = arith.constant 1 : index
574! CHECK-DAG:     %[[VAL_7:.*]] = arith.constant 32 : i8
575! CHECK-DAG:     %[[VAL_8:.*]] = arith.constant 0 : index
576! CHECK:         %[[VAL_10:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,12>>
577! CHECK:         %[[VAL_11:.*]] = fir.extract_value %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
578! CHECK:         %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.boxproc<() -> ()>) -> (() -> ())
579! CHECK:         %[[VAL_13:.*]] = fir.extract_value %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
580! CHECK:         %[[VAL_14:.*]] = llvm.intr.stacksave : !llvm.ptr
581! CHECK:         %[[VAL_15:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_13]] : i64) {bindc_name = ".result"}
582! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
583! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
584! CHECK:         %[[VAL_18:.*]] = fir.call %[[VAL_16]](%[[VAL_15]], %[[VAL_17]]) {{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
585! CHECK:         %[[VAL_19:.*]] = arith.addi %[[VAL_17]], %[[VAL_4]] : index
586! CHECK:         %[[VAL_20:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_19]] : index) {bindc_name = ".chrtmp"}
587! CHECK:         %[[VAL_21:.*]] = fir.convert %[[VAL_4]] : (index) -> i64
588! CHECK:         %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
589! CHECK:         %[[VAL_23:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
590! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_22]], %[[VAL_23]], %[[VAL_21]], %[[VAL_5]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
591! CHECK:         br ^bb1(%[[VAL_4]], %[[VAL_17]] : index, index)
592! CHECK:       ^bb1(%[[VAL_24:.*]]: index, %[[VAL_25:.*]]: index):
593! CHECK:         %[[VAL_26:.*]] = arith.cmpi sgt, %[[VAL_25]], %[[VAL_8]] : index
594! CHECK:         cond_br %[[VAL_26]], ^bb2, ^bb3
595! CHECK:       ^bb2:
596! CHECK:         %[[VAL_27:.*]] = arith.subi %[[VAL_24]], %[[VAL_4]] : index
597! CHECK:         %[[VAL_28:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
598! CHECK:         %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_28]], %[[VAL_27]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
599! CHECK:         %[[VAL_30:.*]] = fir.load %[[VAL_29]] : !fir.ref<!fir.char<1>>
600! CHECK:         %[[VAL_31:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
601! CHECK:         %[[VAL_32:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_24]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
602! CHECK:         fir.store %[[VAL_30]] to %[[VAL_32]] : !fir.ref<!fir.char<1>>
603! CHECK:         %[[VAL_33:.*]] = arith.addi %[[VAL_24]], %[[VAL_6]] : index
604! CHECK:         %[[VAL_34:.*]] = arith.subi %[[VAL_25]], %[[VAL_6]] : index
605! CHECK:         br ^bb1(%[[VAL_33]], %[[VAL_34]] : index, index)
606! CHECK:       ^bb3:
607! CHECK:         %[[VAL_35:.*]] = arith.cmpi sgt, %[[VAL_19]], %[[VAL_3]] : index
608! CHECK:         %[[VAL_36:.*]] = arith.select %[[VAL_35]], %[[VAL_3]], %[[VAL_19]] : index
609! CHECK:         %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (index) -> i64
610! CHECK:         %[[VAL_38:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<i8>
611! CHECK:         fir.call @llvm.memmove.p0.p0.i64(%[[VAL_38]], %[[VAL_22]], %[[VAL_37]], %[[VAL_5]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
612! CHECK:         %[[VAL_39:.*]] = fir.undefined !fir.char<1>
613! CHECK:         %[[VAL_40:.*]] = fir.insert_value %[[VAL_39]], %[[VAL_7]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
614! CHECK:         %[[VAL_41:.*]] = arith.subi %[[VAL_3]], %[[VAL_36]] : index
615! CHECK:         br ^bb4(%[[VAL_36]], %[[VAL_41]] : index, index)
616! CHECK:       ^bb4(%[[VAL_42:.*]]: index, %[[VAL_43:.*]]: index):
617! CHECK:         %[[VAL_44:.*]] = arith.cmpi sgt, %[[VAL_43]], %[[VAL_8]] : index
618! CHECK:         cond_br %[[VAL_44]], ^bb5, ^bb6
619! CHECK:       ^bb5:
620! CHECK:         %[[VAL_45:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<!fir.array<40x!fir.char<1>>>
621! CHECK:         %[[VAL_46:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_42]] : (!fir.ref<!fir.array<40x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
622! CHECK:         fir.store %[[VAL_40]] to %[[VAL_46]] : !fir.ref<!fir.char<1>>
623! CHECK:         %[[VAL_47:.*]] = arith.addi %[[VAL_42]], %[[VAL_6]] : index
624! CHECK:         %[[VAL_48:.*]] = arith.subi %[[VAL_43]], %[[VAL_6]] : index
625! CHECK:         br ^bb4(%[[VAL_47]], %[[VAL_48]] : index, index)
626! CHECK:       ^bb6:
627! CHECK:         llvm.intr.stackrestore %[[VAL_14]] : !llvm.ptr
628! CHECK:         %[[VAL_49:.*]] = fir.emboxchar %[[VAL_0]], %[[VAL_3]] : (!fir.ref<!fir.char<1,40>>, index) -> !fir.boxchar<1>
629! CHECK:         return %[[VAL_49]] : !fir.boxchar<1>
630! CHECK:       }
631
632subroutine test_proc_dummy_char
633  character(40) get_message
634  external get_message
635  character(10) message
636  message = "Hi there!"
637  print *, get_message(gen_message)
638contains
639  function gen_message
640    character(10) :: gen_message
641    gen_message = message
642  end function gen_message
643end subroutine test_proc_dummy_char
644
645function get_message(a)
646  character(40) :: get_message
647  character(*) :: a
648  get_message = "message is: " // a()
649end function get_message
650
651! CHECK-LABEL: func @_QPtest_11a() {
652! CHECK: %[[a:.*]] = fir.address_of(@_QPtest_11b) : () -> ()
653! CHECK: %[[b:.*]] = fir.emboxproc %[[a]] : (() -> ()) -> !fir.boxproc<() -> ()>
654! CHECK: fir.call @_QPtest_11c(%[[b]], %{{.*}}) {{.*}}: (!fir.boxproc<() -> ()>, !fir.ref<i32>) -> ()
655! CHECK: func private @_QPtest_11c(!fir.boxproc<() -> ()>, !fir.ref<i32>)
656
657subroutine test_11a
658  external test_11b
659  call test_11c(test_11b, 3)
660end subroutine test_11a
661
662subroutine test_PDT_with_init_do_not_crash_host_symbol_analysis()
663  integer :: i
664  call sub()
665contains
666  subroutine sub()
667    ! PDT definition symbols maps to un-analyzed expression,
668    ! check this does not crash the visit of the internal procedure
669    ! parse-tree to get the list of captured host variables.
670    type type1 (k)
671      integer, KIND :: k
672      integer :: x = k
673    end type
674    type type2 (k, l)
675      integer, KIND :: k = 4
676      integer, LEN :: l = 2
677      integer :: x = 10
678      real :: y = 20
679    end type
680    print *, i
681  end subroutine
682end subroutine
683