xref: /llvm-project/flang/test/Lower/dummy-argument-optional-2.f90 (revision 9f44d5d9d0903adaa9deb35d33056202e5030cb3) 
1! Test passing pointer, allocatables, and optional assumed shapes to optional
2! explicit shapes (see F2018 15.5.2.12).
3! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
4module optional_tests
5implicit none
6interface
7subroutine takes_opt_scalar(i)
8  integer, optional :: i
9end subroutine
10subroutine takes_opt_scalar_char(c)
11  character(*), optional :: c
12end subroutine
13subroutine takes_opt_explicit_shape(x)
14  real, optional :: x(100)
15end subroutine
16subroutine takes_opt_explicit_shape_intentout(x)
17  real, optional, intent(out) :: x(100)
18end subroutine
19subroutine takes_opt_explicit_shape_intentin(x)
20  real, optional, intent(in) :: x(100)
21end subroutine
22subroutine takes_opt_explicit_shape_char(c)
23  character(*), optional :: c(100)
24end subroutine
25function returns_pointer()
26  real, pointer :: returns_pointer(:)
27end function
28end interface
29contains
30
31! -----------------------------------------------------------------------------
32!     Test passing scalar pointers and allocatables to an optional
33! -----------------------------------------------------------------------------
34! Here, nothing optional specific is expected, the address is passed, and its
35! allocation/association status match the dummy presence status.
36
37! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar(
38! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>>{{.*}}) {
39subroutine pass_pointer_scalar(i)
40  integer, pointer :: i
41  call takes_opt_scalar(i)
42! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
43! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
44! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<i32>) -> !fir.ref<i32>
45! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()
46end subroutine
47
48! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar(
49! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<i32>>>{{.*}}) {
50subroutine pass_allocatable_scalar(i)
51  integer, allocatable :: i
52  call takes_opt_scalar(i)
53! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<i32>>>
54! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
55! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<i32>) -> !fir.ref<i32>
56! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()
57end subroutine
58
59! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar_char(
60! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}) {
61subroutine pass_pointer_scalar_char(c)
62  character(:), pointer :: c
63  call takes_opt_scalar_char(c)
64! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
65! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
66! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
67! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_2]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>
68! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
69end subroutine
70
71! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar_char(
72! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}) {
73subroutine pass_allocatable_scalar_char(c)
74  character(:), allocatable :: c
75  call takes_opt_scalar_char(c)
76! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
77! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
78! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
79! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_2]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1>
80! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
81end subroutine
82
83! -----------------------------------------------------------------------------
84!     Test passing non contiguous pointers to explicit shape optional
85! -----------------------------------------------------------------------------
86! The pointer descriptor can be unconditionally read, but the copy-in/copy-out
87! must be conditional on the pointer association status in order to get the
88! correct present/absent aspect.
89
90! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array(
91! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
92subroutine pass_pointer_array(i)
93  real, pointer :: i(:)
94  call takes_opt_explicit_shape(i)
95! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
96! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
97! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
98! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
99! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
100! CHECK:         %[[box:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
101! CHECK:         %[[VAL_7:.*]] = arith.constant 0 : index
102! CHECK:         %[[box_none:.*]] = fir.convert %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
103! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
104! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
105! CHECK:           %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?xf32>>) {
106! CHECK:             %[[box_addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
107! CHECK:             fir.result %[[box_addr]] : !fir.heap<!fir.array<?xf32>>
108! CHECK:           } else {
109! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
110! CHECK:           %[[VAL_11:.*]]:3 = fir.box_dims %[[box]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
111! CHECK:           %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]]#1 {uniq_name = ".copyinout"}
112! CHECK:           fir.call @_FortranAAssignTemporary
113! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
114! CHECK:         } else {
115! CHECK:           %[[VAL_26:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
116! CHECK:           fir.result %[[VAL_26]] : !fir.heap<!fir.array<?xf32>>
117! CHECK:         }
118! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
119! CHECK:         %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1
120! CHECK:         %[[VAL_29:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
121! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_29]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
122! CHECK:         fir.if %[[and]] {
123! CHECK:           fir.call @_FortranACopyOutAssign
124! CHECK:         }
125end subroutine
126
127! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array_char(
128! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
129subroutine pass_pointer_array_char(c)
130  character(:), pointer :: c(:)
131  call takes_opt_explicit_shape_char(c)
132! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
133! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
134! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> i64
135! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
136! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
137! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
138! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.box<none>
139! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
140! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
141! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
142! CHECK:           %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>, index) -> (index, index, index)
143! CHECK:           %[[VAL_12:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
144! CHECK:           %[[VAL_13:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_12]] : index), %[[VAL_11]]#1 {uniq_name = ".copyinout"}
145! CHECK:           fir.call @_FortranAAssignTemporary
146! CHECK:           fir.result %[[VAL_13]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
147! CHECK:         } else {
148! CHECK:           %[[VAL_46:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
149! CHECK:           fir.result %[[VAL_46]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
150! CHECK:         }
151! CHECK:         %[[VAL_47:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
152! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
153! CHECK:         %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1
154! CHECK:         %[[VAL_50:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
155! CHECK:         %[[VAL_52:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_47]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
156! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_52]]) {{.*}}: (!fir.boxchar<1>) -> ()
157! CHECK:         fir.if %[[and]] {
158! CHECK:           fir.call @_FortranACopyOutAssign
159! CHECK:         }
160! CHECK:         return
161! CHECK:       }
162end subroutine
163
164! This case is bit special because the pointer is not a symbol but a function
165! result. Test that the copy-in/copy-out is the same as with normal pointers.
166
167! CHECK-LABEL: func @_QMoptional_testsPforward_pointer_array() {
168subroutine forward_pointer_array()
169  call takes_opt_explicit_shape(returns_pointer())
170! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = ".result"}
171! CHECK:         %[[VAL_1:.*]] = fir.call @_QPreturns_pointer() {{.*}}: () -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
172! CHECK:         fir.save_result %[[VAL_1]] to %[[VAL_0]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
173! CHECK:         %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
174! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
175! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
176! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : i64
177! CHECK:         %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64
178! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1
179! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.heap<!fir.array<?xf32>>) {
180! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
181! CHECK:           fir.call @_FortranAAssignTemporary
182! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
183! CHECK:         } else {
184! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
185! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
186! CHECK:         }
187! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
188! CHECK:         %[[and:.*]] = arith.andi %[[VAL_6]], %[[not_contiguous]] : i1
189! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
190! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
191! CHECK:         fir.if %[[and]] {
192! CHECK:           fir.call @_FortranACopyOutAssign
193! CHECK:         }
194end subroutine
195
196! -----------------------------------------------------------------------------
197!    Test passing assumed shape optional to explicit shape optional
198! -----------------------------------------------------------------------------
199! The fix.box can only be read if the assumed shape is present,
200! and the copy-in/copy-out must also be conditional on the assumed
201! shape presence.
202
203! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape(
204! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
205subroutine pass_opt_assumed_shape(x)
206  real, optional :: x(:)
207  call takes_opt_explicit_shape(x)
208! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
209! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
210! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
211! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
212! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
213! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
214! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1
215! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
216! CHECK:           %[[VAL_8:.*]] = arith.constant 0 : index
217! CHECK:           %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_8]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
218! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_9]]#1 {uniq_name = ".copyinout"}
219! CHECK:           fir.call @_FortranAAssignTemporary
220! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
221! CHECK:         } else {
222! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
223! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
224! CHECK:         }
225! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
226! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
227! CHECK:         %[[VAL_26:.*]] = fir.convert %[[VAL_27:.*]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
228! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_26]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
229! CHECK:         fir.if %[[and]] {
230! CHECK:           fir.call @_FortranACopyOutAssign
231! CHECK:         }
232end subroutine
233
234! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_char(
235! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.optional}) {
236subroutine pass_opt_assumed_shape_char(c)
237  character(*), optional :: c(:)
238  call takes_opt_explicit_shape_char(c)
239! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
240! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
241! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
242! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
243! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
244! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
245! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
246! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>
247! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
248! CHECK:         %[[VAL_8:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
249! CHECK:         %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
250! CHECK:           %[[res:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
251! CHECK:           fir.result %[[res]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
252! CHECK:         } else {
253! CHECK:           %[[box_elesize:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
254! CHECK:           %[[temp:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[box_elesize]] : index), %{{.*}}#1 {uniq_name = ".copyinout"}
255! CHECK:           fir.call @_FortranAAssignTemporary
256! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
257! CHECK:         } else {
258! CHECK:           %[[VAL_44:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
259! CHECK:           fir.result %[[VAL_44]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
260! CHECK:         }
261! CHECK:         %[[VAL_45:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
262! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
263! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
264! CHECK:         %[[VAL_48:.*]] = fir.convert %[[VAL_49:.*]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
265! CHECK:         %[[VAL_50:.*]] = fir.emboxchar %[[VAL_48]], %[[VAL_45]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
266! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_50]]) {{.*}}: (!fir.boxchar<1>) -> ()
267! CHECK:         fir.if %[[and]] {
268! CHECK:           fir.call @_FortranACopyOutAssign
269! CHECK:         }
270end subroutine
271
272! -----------------------------------------------------------------------------
273!    Test passing contiguous optional assumed shape to explicit shape optional
274! -----------------------------------------------------------------------------
275! The fix.box can only be read if the assumed shape is present.
276! There should be no copy-in/copy-out
277
278! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape(
279! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
280subroutine pass_opt_contiguous_assumed_shape(x)
281  real, optional, contiguous :: x(:)
282  call takes_opt_explicit_shape(x)
283! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
284! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
285! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
286! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
287! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
288! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
289! CHECK:         %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
290! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
291! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_8]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
292end subroutine
293
294! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape_char(
295! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous, fir.optional}) {
296subroutine pass_opt_contiguous_assumed_shape_char(c)
297  character(*), optional, contiguous :: c(:)
298  call takes_opt_explicit_shape_char(c)
299! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
300! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
301! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
302! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
303! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
304! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
305! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
306! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
307! CHECK:         %[[VAL_9:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
308! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
309! CHECK:         %[[VAL_11:.*]] = fir.emboxchar %[[VAL_10]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
310! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_11]]) {{.*}}: (!fir.boxchar<1>) -> ()
311end subroutine
312
313! -----------------------------------------------------------------------------
314!    Test passing allocatables and contiguous pointers to explicit shape optional
315! -----------------------------------------------------------------------------
316! The fix.box can be read and its address directly passed. There should be no
317! copy-in/copy-out.
318
319! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array(
320! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
321subroutine pass_allocatable_array(i)
322  real, allocatable :: i(:)
323  call takes_opt_explicit_shape(i)
324! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
325! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
326! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
327! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
328end subroutine
329
330! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array_char(
331! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
332subroutine pass_allocatable_array_char(c)
333  character(:), allocatable :: c(:)
334  call takes_opt_explicit_shape_char(c)
335! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
336! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
337! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
338! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
339! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
340! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
341end subroutine
342
343! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array(
344! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "i", fir.contiguous}) {
345subroutine pass_contiguous_pointer_array(i)
346  real, pointer, contiguous :: i(:)
347  call takes_opt_explicit_shape(i)
348! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
349! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
350! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
351! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
352end subroutine
353
354! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array_char(
355! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "c", fir.contiguous}) {
356subroutine pass_contiguous_pointer_array_char(c)
357  character(:), pointer, contiguous :: c(:)
358  call takes_opt_explicit_shape_char(c)
359! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
360! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
361! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
362! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
363! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
364! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
365end subroutine
366
367! -----------------------------------------------------------------------------
368!    Test passing assumed shape optional to explicit shape optional with intents
369! -----------------------------------------------------------------------------
370! The fix.box can only be read if the assumed shape is present,
371! and the copy-in/copy-out must also be conditional on the assumed
372! shape presence. For intent(in), there should be no copy-out while for
373! intent(out), there should be no copy-in.
374
375! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentin(
376! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
377subroutine pass_opt_assumed_shape_to_intentin(x)
378  real, optional :: x(:)
379  call takes_opt_explicit_shape_intentin(x)
380! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
381! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
382! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
383! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
384! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
385! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
386! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
387! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
388! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
389! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
390! CHECK:           fir.call @_FortranAAssignTemporary
391! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
392! CHECK:         } else {
393! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
394! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
395! CHECK:         }
396! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
397! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
398! CHECK:         %[[VAL_24:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
399! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
400! CHECK:         fir.if %[[and]] {
401! CHECK:           fir.zero
402! CHECK:           fir.call @_FortranACopyOutAssign
403! CHECK:         }
404end subroutine
405
406! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentout(
407! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
408subroutine pass_opt_assumed_shape_to_intentout(x)
409  real, optional :: x(:)
410  call takes_opt_explicit_shape_intentout(x)
411! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
412! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
413! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
414! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
415! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
416! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
417! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
418! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
419! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
420! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
421! CHECK-NOT:       fir.call @_FortranAAssignTemporary
422! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
423! CHECK:         } else {
424! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
425! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
426! CHECK:         }
427! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
428! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
429! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
430! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentout(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
431! CHECK:         fir.if %[[and]] {
432! CHECK:           fir.call @_FortranACopyOutAssign
433! CHECK:         }
434end subroutine
435end module
436