TheRock/compiler/amd-llvm/flang/test/Lower/default-initialization.f90

! Test default initialization of local and dummy variables (dynamic initialization)
! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s

module test_dinit
  type t
    integer :: i = 42
  end type
  type t_alloc_comp
    real, allocatable :: i(:)
  end type
  type tseq
    sequence
    integer :: i = 42
  end type
contains

! -----------------------------------------------------------------------------
!            Test default initialization of local and dummy variables.
! -----------------------------------------------------------------------------

  ! Test local scalar is default initialized
  ! CHECK-LABEL: func @_QMtest_dinitPlocal()
  subroutine local
    !CHECK: %[[xalloc:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}> {bindc_name = "x", uniq_name = "_QMtest_dinitFlocalEx"}
    !CHECK: %[[x:.*]]:2 = hlfir.declare %[[xalloc]] {uniq_name = "_QMtest_dinitFlocalEx"}
    !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    !CHECK: fir.copy %[[ADDR]] to %[[x]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    type(t) :: x
    print *, x%i
  end subroutine

  ! Test local array is default initialized
  ! CHECK-LABEL: func @_QMtest_dinitPlocal_array()
  subroutine local_array()
    ! CHECK: %[[xalloc:.*]] = fir.alloca !fir.array<4x!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    ! CHECK: %[[x:.*]]:2 = hlfir.declare %[[xalloc]](%{{.*}}) {uniq_name = "_QMtest_dinitFlocal_arrayEx"}
    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]]#0(%{{.*}}) : (!fir.ref<!fir.array<4x!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>>
    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> ()
    type(t) :: x(4)
    print *, x(2)%i
  end subroutine

  ! Test allocatable component triggers default initialization of local
  ! scalars.
  ! CHECK-LABEL: func @_QMtest_dinitPlocal_alloc_comp()
  subroutine local_alloc_comp
    !CHECK: %[[xalloc:.*]] = fir.alloca !fir.type<_QMtest_dinitTt_alloc_comp{{(,sequence)?}}{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}> {bindc_name = "x", uniq_name = "_QMtest_dinitFlocal_alloc_compEx"}
    !CHECK: %[[x:.*]]:2 = hlfir.declare %[[xalloc]] {uniq_name = "_QMtest_dinitFlocal_alloc_compEx"}
    !CHECK: %[[COORD:.*]] = fir.coordinate_of %[[x]]#0, i : (!fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
    !CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
    !CHECK: %[[SHAPE:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
    !CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
    !CHECK: fir.store %[[EMBOX]] to %[[COORD]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
    type(t_alloc_comp) :: x
  end subroutine

  ! Test function results are default initialized.
  ! CHECK-LABEL: func @_QMtest_dinitPresult() -> !fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>
  function result()
    !CHECK: %[[xalloc:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}> {bindc_name = "result", uniq_name = "_QMtest_dinitFresultEresult"}
    !CHECK: %[[x:.*]]:2 = hlfir.declare %[[xalloc]] {uniq_name = "_QMtest_dinitFresultEresult"}
    !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    !CHECK: fir.copy %[[ADDR]] to %[[x]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    type(t) :: result
  end function

  ! Test intent(out) dummies are default initialized
  ! CHECK-LABEL: func @_QMtest_dinitPintent_out(
  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
  subroutine intent_out(x)
    !CHECK: %[[x:.*]]:2 = hlfir.declare %[[arg0]] {{.*}} {fortran_attrs = #fir.var_attrs<intent_out>, uniq_name = "_QMtest_dinitFintent_outEx"}
    !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    !CHECK: fir.copy %[[ADDR]] to %[[x]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
    type(t), intent(out) :: x
  end subroutine

  ! Test that optional intent(out) are default initialized only when
  ! present.
  ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(
  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>> {fir.bindc_name = "x", fir.optional})
  subroutine intent_out_optional(x)
    ! CHECK: %[[x:.*]]:2 = hlfir.declare %[[arg0]] {{.*}} {fortran_attrs = #fir.var_attrs<intent_out, optional>, uniq_name = "_QMtest_dinitFintent_out_optionalEx"}
    ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]]#0 : (!fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>) -> i1
    ! CHECK: fir.if %[[isPresent]] {
      ! CHECK: %[[xbox:.*]] = fir.embox %[[x]]#0 : (!fir.ref<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{{(,sequence)?}}{i:i32}>>
      ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
      ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> ()
    ! CHECK: }
    type(t), intent(out), optional :: x
  end subroutine

  ! Test local equivalences where one entity has default initialization
  ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq()
  subroutine local_eq()
    type(tseq) :: x
    integer :: zi
    ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
    ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
    ! CHECK: %[[xptr:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: %[[x:.*]]:2 = hlfir.declare %[[xptr]] storage(%[[equiv]][0]) {uniq_name = "_QMtest_dinitFlocal_eqEx"}
    ! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: fir.copy %[[ADDR]] to %[[x]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    equivalence (x, zi)
    print *, i
  end subroutine

  ! Test local equivalences with both equivalenced entities being
  ! default initialized. Note that the standard allow default initialization
  ! to be performed several times as long as the values are the same. So
  ! far that is what lowering is doing to stay simple.
  ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq2()
  subroutine local_eq2()
    type(tseq) :: x
    type(tseq) :: y
    ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
    ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
    ! CHECK: %[[xptr:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: %[[x:.*]]:2 = hlfir.declare %[[xptr]] storage(%[[equiv]][0]) {uniq_name = "_QMtest_dinitFlocal_eq2Ex"}
    ! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: fir.copy %[[ADDR]] to %[[x]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>


    ! CHECK: %[[ycoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
    ! CHECK: %[[yptr:.*]] = fir.convert %[[ycoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: %[[y:.*]]:2 = hlfir.declare %[[yptr]] storage(%[[equiv]][0]) {uniq_name = "_QMtest_dinitFlocal_eq2Ey"}
    ! CHECK: %[[ADDR2:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    ! CHECK: fir.copy %[[ADDR2]] to %[[y]]#0 no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{{(,sequence)?}}{i:i32}>>
    equivalence (x, y)
    print *, y%i
  end subroutine


! -----------------------------------------------------------------------------
!        Test for local and dummy variables that must not be initialized
! -----------------------------------------------------------------------------

  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_alloc
  subroutine noinit_local_alloc
    ! CHECK-NOT: fir.call @_FortranAInitialize
    type(t), allocatable :: x
    ! CHECK: return
  end subroutine

  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_pointer
  subroutine noinit_local_pointer
    ! CHECK-NOT: fir.call @_FortranAInitialize
    type(t), pointer :: x
    ! CHECK: return
  end subroutine

  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_normal_dummy
  subroutine noinit_normal_dummy(x)
    ! CHECK-NOT: fir.call @_FortranAInitialize
    type(t) :: x
    ! CHECK: return
  end subroutine

  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_intentinout_dummy
  subroutine noinit_intentinout_dummy(x)
    ! CHECK-NOT: fir.call @_FortranAInitialize
    type(t), intent(inout) :: x
    ! CHECK: return
  end subroutine


  subroutine test_pointer_intentout(a, b)
    type(t), pointer, intent(out) :: a
    class(t), pointer, intent(out) :: b
  end subroutine

! CHECK-LABEL: func.func @_QMtest_dinitPtest_pointer_intentout(
! CHECK-NOT: fir.call @_FortranAInitialize

end module

! CHECK-LABEL: func.func @_QQmain

! End-to-end test for debug pruposes.
  use test_dinit
  type(t) :: at
  call local()
  call local_array()
  at%i = 66
  call intent_out(at)
  print *, at%i
  at%i = 66
  call intent_out_optional(at)
  print *, at%i
  call intent_out_optional()
  call local_eq()
  call local_eq2()
end