xref: /llvm-project/flang/test/Lower/HLFIR/array-ctor-as-elemental-nested.f90 (revision 3be8e3ad0c424dbeb9e4c8401174335e106a2d5d)
1! Test lowering of nested array constructors as hlfir.elemental.
2! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
3
4! hlfir.end_associate and hlfir.destroy used to be generated
5! after hlfir.yield_element for the outermost hlfir.elemental.
6
7! CHECK-LABEL:   func.func @_QPtest(
8! CHECK-SAME:                       %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "pi"},
9! CHECK-SAME:                       %[[VAL_1:.*]]: !fir.ref<!fir.array<2xf32>> {fir.bindc_name = "h1"}) {
10! CHECK:           %[[VAL_2:.*]] = arith.constant 2 : index
11! CHECK:           %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
12! CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) dummy_scope %{{[0-9]+}} {uniq_name = "_QFtestEh1"} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>)
13! CHECK:           %[[VAL_5:.*]] = fir.alloca i32 {bindc_name = "k", uniq_name = "_QFtestEk"}
14! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "_QFtestEk"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
15! CHECK:           %[[VAL_7:.*]] = fir.alloca i32 {bindc_name = "l", uniq_name = "_QFtestEl"}
16! CHECK:           %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] {uniq_name = "_QFtestEl"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
17! CHECK:           %[[VAL_9:.*]] = fir.address_of(@_QFtestECn) : !fir.ref<i32>
18! CHECK:           %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtestECn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
19! CHECK:           %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFtestEpi"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)
20! CHECK:           %[[VAL_12:.*]] = arith.constant 2 : index
21! CHECK:           %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1>
22! CHECK:           %[[VAL_14:.*]] = hlfir.elemental %[[VAL_13]] unordered : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
23! CHECK:           ^bb0(%[[VAL_15:.*]]: index):
24! CHECK:             %[[VAL_16:.*]] = arith.constant 2 : index
25! CHECK:             %[[VAL_17:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
26! CHECK:             %[[VAL_18:.*]] = hlfir.elemental %[[VAL_17]] unordered : (!fir.shape<1>) -> !hlfir.expr<2xf32> {
27! CHECK:             ^bb0(%[[VAL_19:.*]]: index):
28! CHECK:               %[[VAL_20:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref<f32>
29! CHECK:               hlfir.yield_element %[[VAL_20]] : f32
30! CHECK:             }
31! CHECK:             %[[VAL_21:.*]]:3 = hlfir.associate %[[VAL_22:.*]](%[[VAL_17]]) {adapt.valuebyref} : (!hlfir.expr<2xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xf32>>, !fir.ref<!fir.array<2xf32>>, i1)
32! CHECK:             %[[VAL_23:.*]] = fir.embox %[[VAL_21]]#0(%[[VAL_17]]) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xf32>>
33! CHECK:             %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.box<!fir.array<2xf32>>) -> !fir.box<!fir.array<?xf32>>
34! CHECK:             %[[VAL_25:.*]] = fir.call @_QPfoo(%[[VAL_24]]) proc_attrs<pure> fastmath<contract> : (!fir.box<!fir.array<?xf32>>) -> f32
35! CHECK:             hlfir.end_associate %[[VAL_21]]#1, %[[VAL_21]]#2 : !fir.ref<!fir.array<2xf32>>, i1
36! CHECK:             hlfir.destroy %[[VAL_22]] : !hlfir.expr<2xf32>
37! CHECK:             hlfir.yield_element %[[VAL_25]] : f32
38! CHECK:           }
39! CHECK:           hlfir.assign %[[VAL_26:.*]] to %[[VAL_4]]#0 : !hlfir.expr<2xf32>, !fir.ref<!fir.array<2xf32>>
40! CHECK:           hlfir.destroy %[[VAL_26]] : !hlfir.expr<2xf32>
41! CHECK:           return
42! CHECK:         }
43subroutine test(pi,h1)
44  implicit none
45  integer, parameter :: N = 2
46  interface
47     pure real function foo(x)
48       real, intent(in) :: x(:)
49     end function foo
50  end interface
51  real h1(1:N)
52  integer k, l
53  real pi
54  h1 = (/(foo((/(pi,l=1,N)/)),k=1,N)/)
55end subroutine test
56