1! Test lowering of internal procedures returning arrays or characters.
2! This test allocation on the caller side of the results that may depend on
3! host associated symbols.
4! RUN: bbc %s -o - | FileCheck %s
5
6module some_module
7 integer :: n_module
8end module
9
10! Test host calling array internal procedure.
11! Result depends on host variable.
12! CHECK-LABEL: func @_QPhost1
13subroutine host1()
14  implicit none
15  integer :: n
16! CHECK:  %[[VAL_1:.*]] = fir.alloca i32
17  call takes_array(return_array())
18! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
19! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
20! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_5]] {bindc_name = ".result"}
21contains
22  function return_array()
23    real :: return_array(n)
24  end function
25end subroutine
26
27! Test host calling array internal procedure.
28! Result depends on module variable with the use statement inside the host.
29! CHECK-LABEL: func @_QPhost2
30subroutine host2()
31  use :: some_module
32  call takes_array(return_array())
33! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
34! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
35! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
36! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_2]] {bindc_name = ".result"}
37contains
38  function return_array()
39    real :: return_array(n_module)
40  end function
41end subroutine
42
43! Test host calling array internal procedure.
44! Result depends on module variable with the use statement inside the internal procedure.
45! CHECK-LABEL: func @_QPhost3
46subroutine host3()
47  call takes_array(return_array())
48! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
49! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
50! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
51! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_2]] {bindc_name = ".result"}
52contains
53  function return_array()
54    use :: some_module
55    real :: return_array(n_module)
56  end function
57end subroutine
58
59! Test internal procedure A calling array internal procedure B.
60! Result depends on host variable not directly used in A.
61subroutine host4()
62  implicit none
63  integer :: n
64  call internal_proc_a()
65contains
66! CHECK-LABEL: func @_QFhost4Pinternal_proc_a
67! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
68  subroutine internal_proc_a()
69    call takes_array(return_array())
70! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
71! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
72! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
73! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
74! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
75! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_5]] {bindc_name = ".result"}
76  end subroutine
77  function return_array()
78    real :: return_array(n)
79  end function
80end subroutine
81
82! Test internal procedure A calling array internal procedure B.
83! Result depends on module variable with use statement in the host.
84subroutine host5()
85  use :: some_module
86  implicit none
87  call internal_proc_a()
88contains
89! CHECK-LABEL: func @_QFhost5Pinternal_proc_a() {
90  subroutine internal_proc_a()
91    call takes_array(return_array())
92! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
93! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
94! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
95! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_2]] {bindc_name = ".result"}
96  end subroutine
97  function return_array()
98    real :: return_array(n_module)
99  end function
100end subroutine
101
102! Test internal procedure A calling array internal procedure B.
103! Result depends on module variable with use statement in B.
104subroutine host6()
105  implicit none
106  call internal_proc_a()
107contains
108! CHECK-LABEL: func @_QFhost6Pinternal_proc_a
109  subroutine internal_proc_a()
110    call takes_array(return_array())
111! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
112! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
113! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
114! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_2]] {bindc_name = ".result"}
115  end subroutine
116  function return_array()
117    use :: some_module
118    real :: return_array(n_module)
119  end function
120end subroutine
121
122! Test host calling array internal procedure.
123! Result depends on a common block variable declared in the host.
124! CHECK-LABEL: func @_QPhost7
125subroutine host7()
126  implicit none
127  integer :: n_common
128  common /mycom/ n_common
129  call takes_array(return_array())
130! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
131! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
132! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
133! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
134! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32>
135! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
136! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
137! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_9]] {bindc_name = ".result"}
138contains
139  function return_array()
140    real :: return_array(n_common)
141  end function
142end subroutine
143
144! Test host calling array internal procedure.
145! Result depends on a common block variable declared in the internal procedure.
146! CHECK-LABEL: func @_QPhost8
147subroutine host8()
148  implicit none
149  call takes_array(return_array())
150! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
151! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
152! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
153! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
154! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
155! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
156! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
157! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_6]] {bindc_name = ".result"}
158contains
159  function return_array()
160    integer :: n_common
161    common /mycom/ n_common
162    real :: return_array(n_common)
163  end function
164end subroutine
165
166! Test internal procedure A calling array internal procedure B.
167! Result depends on a common block variable declared in the host.
168! Note that the current implementation captures the common block variable
169! address, even though it could recompute it in the internal procedure.
170subroutine host9()
171  implicit none
172  integer :: n_common
173  common /mycom/ n_common
174  call internal_proc_a()
175contains
176! CHECK-LABEL: func @_QFhost9Pinternal_proc_a
177! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
178  subroutine internal_proc_a()
179! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
180! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
181! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
182! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
183! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
184! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_5]] {bindc_name = ".result"}
185    call takes_array(return_array())
186  end subroutine
187  function return_array()
188    use :: some_module
189    real :: return_array(n_common)
190  end function
191end subroutine
192
193! Test internal procedure A calling array internal procedure B.
194! Result depends on a common block variable declared in B.
195subroutine host10()
196  implicit none
197  call internal_proc_a()
198contains
199! CHECK-LABEL: func @_QFhost10Pinternal_proc_a
200  subroutine internal_proc_a()
201    call takes_array(return_array())
202! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
203! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
204! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
205! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
206! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
207! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
208! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
209! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_6]] {bindc_name = ".result"}
210  end subroutine
211  function return_array()
212    integer :: n_common
213    common /mycom/ n_common
214    real :: return_array(n_common)
215  end function
216end subroutine
217
218
219! Test call to a function returning an array where the interface is use
220! associated from a module.
221module define_interface
222contains
223function foo()
224  real :: foo(100)
225  foo = 42
226end function
227end module
228! CHECK-LABEL: func @_QPtest_call_to_used_interface(
229! CHECK-SAME:  %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
230subroutine test_call_to_used_interface(dummy_proc)
231  use define_interface
232  procedure(foo) :: dummy_proc
233  call takes_array(dummy_proc())
234! CHECK:  %[[VAL_1:.*]] = arith.constant 100 : index
235! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = ".result"}
236! CHECK:  %[[VAL_3:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
237! CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
238! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> !fir.array<100xf32>)
239! CHECK:  %[[VAL_6:.*]] = fir.call %[[VAL_5]]() : () -> !fir.array<100xf32>
240! CHECK:  fir.save_result %[[VAL_6]] to %[[VAL_2]](%[[VAL_4]]) : !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>, !fir.shape<1>
241! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>>
242! CHECK:  fir.call @_QPtakes_array(%[[VAL_7]]) : (!fir.ref<!fir.array<?xf32>>) -> ()
243! CHECK:  fir.call @llvm.stackrestore(%[[VAL_3]]) : (!fir.ref<i8>) -> ()
244end subroutine
245