flang/test/Lower/do_concurrent_local_default_init.f90

   1 ! Test default initialization of DO CONCURRENT LOCAL() entities.
   2 ! RUN: bbc -emit-hlfir -I nowhere -o - %s | FileCheck %s
   3
   4 subroutine test_ptr(p)
   5   interface
   6     pure subroutine takes_ptr(p)
   7       character(*), intent(in), pointer :: p(:)
   8     end subroutine
   9   end interface
  10   character(*), pointer :: p(:)
  11   integer :: i
  12   do concurrent (i=1:10) local(p)
  13     call takes_ptr(p)
  14   end do
  15 end subroutine
  16
  17 subroutine test_default_init()
  18   type t
  19     integer :: i = 2
  20   end type
  21   integer :: i, res(4)
  22   type(t) :: a
  23   do concurrent (i=1:4) local(a)
  24     res(i) = a%i
  25   end do
  26   call something(res)
  27 end subroutine
  28 ! CHECK-LABEL:   func.func @_QPtest_ptr(
  29 ! CHECK-SAME:                           %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "p"}) {
  30 ! CHECK:           %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
  31 ! CHECK:           %[[VAL_7:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
  32 ! CHECK:           fir.do_loop
  33 ! CHECK:             %[[VAL_16:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {bindc_name = "p", pinned, uniq_name = "_QFtest_ptrEp"}
  34 ! CHECK:             %[[VAL_17:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,?>>>
  35 ! CHECK:             %[[VAL_18:.*]] = arith.constant 0 : index
  36 ! CHECK:             %[[VAL_19:.*]] = fir.shape %[[VAL_18]] : (index) -> !fir.shape<1>
  37 ! CHECK:             %[[VAL_20:.*]] = fir.embox %[[VAL_17]](%[[VAL_19]]) typeparams %[[VAL_7]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
  38 ! CHECK:             fir.store %[[VAL_20]] to %[[VAL_16]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
  39 ! CHECK:             %[[VAL_21:.*]]:2 = hlfir.declare %[[VAL_16]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptrEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>)
  40 ! CHECK:             fir.call @_QPtakes_ptr(%[[VAL_21]]#0) proc_attrs<pure> fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()
  41 ! CHECK:           }
  42 ! CHECK:           return
  43 ! CHECK:         }
  44
  45 ! CHECK-LABEL:   func.func @_QPtest_default_init(
  46 ! CHECK:           fir.do_loop
  47 ! CHECK:             %[[VAL_26:.*]] = fir.alloca !fir.type<_QFtest_default_initTt{i:i32}> {bindc_name = "a", pinned, uniq_name = "_QFtest_default_initEa"}
  48 ! CHECK:             %[[VAL_27:.*]] = fir.embox %[[VAL_26]] : (!fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>) -> !fir.box<!fir.type<_QFtest_default_initTt{i:i32}>>
  49 ! CHECK:             %[[VAL_30:.*]] = fir.convert %[[VAL_27]] : (!fir.box<!fir.type<_QFtest_default_initTt{i:i32}>>) -> !fir.box<none>
  50 ! CHECK:             fir.call @_FortranAInitialize(%[[VAL_30]], {{.*}}
  51 ! CHECK:             %[[VAL_33:.*]]:2 = hlfir.declare %[[VAL_26]] {uniq_name = "_QFtest_default_initEa"} : (!fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>) -> (!fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>, !fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>)
  52 ! CHECK:           }