flang/test/Lower/HLFIR/internal-procedures.f90

   1 ! Test captured variables instantiation inside internal procedures
   2 ! when lowering to HLFIR.
   3 ! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
   4 subroutine test_explicit_shape_array(x, n)
   5   integer(8) :: n
   6   real :: x(n)
   7 contains
   8 subroutine internal
   9   call takes_array(x)
  10 end subroutine
  11 end subroutine
  12 ! CHECK-LABEL: func.func @_QFtest_explicit_shape_arrayPinternal(
  13 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
  14 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
  15 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
  16 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
  17 ! CHECK:  %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  18 ! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
  19 ! CHECK:  %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  20 ! CHECK:  %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1>
  21 ! CHECK:  %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_7]]) {uniq_name = "_QFtest_explicit_shape_arrayEx"} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.array<?xf32>>)
  22
  23 subroutine test_assumed_shape(x)
  24   real :: x(:)
  25 contains
  26 subroutine internal
  27   call takes_array(x)
  28 end subroutine
  29 end subroutine
  30 ! CHECK-LABEL: func.func @_QFtest_assumed_shapePinternal(
  31 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
  32 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
  33 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
  34 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
  35 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
  36 ! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  37 ! CHECK:  %[[VAL_6:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
  38 ! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {uniq_name = "_QFtest_assumed_shapeEx"} : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)