pointer-default-init.f90 | Explore in Territory

! Test that pointer and pointer components are always initialized to a
! clean NULL() status. This is required by f18 runtime to do pointer
! association with a RHS with an undefined association status from a
! Fortran point of view.
! RUN: bbc -emit-fir -hlfir=false -I nw %s -o - | FileCheck %s

module test
  type t
    integer :: i
    real, pointer :: x(:)
  end type

  real, pointer :: test_module_pointer(:)
! CHECK-LABEL:   fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
! CHECK:  %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : index
! CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
! CHECK:  %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK:  fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>

  type(t) :: test_module_var
! CHECK-LABEL:   fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
! CHECK:  %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
! CHECK:  %[[VAL_1:.*]] = fir.zero_bits i32
! CHECK:  %[[VAL_2:.*]] = fir.field_index i
! CHECK:  %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
! CHECK:  %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
! CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
! CHECK:  %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK:  %[[VAL_8:.*]] = fir.field_index x
! CHECK:  %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
! CHECK:  fir.has_value %[[VAL_9]]
end module

subroutine test_local()
  use test, only : t
  type(t) :: x
end subroutine
! CHECK-LABEL:   func.func @_QPtest_local() {
! CHECK:  fir.call @_FortranAInitialize(

subroutine test_saved()
  use test, only : t
  type(t), save :: x
end subroutine
! See check for fir.global internal @_QFtest_savedEx below.

subroutine test_alloc(x)
  use test, only : t
  type(t), allocatable :: x
  allocate(x)
end subroutine
! CHECK-LABEL:   func.func @_QPtest_alloc(
! CHECK:  fir.call @_FortranAAllocatableAllocate

subroutine test_intentout(x)
  use test, only : t
  type(t), intent(out):: x
end subroutine
! CHECK-LABEL:   func.func @_QPtest_intentout(
! CHECK-NOT:           fir.call @_FortranAInitialize(
! CHECK:  return

subroutine test_struct_ctor_cst(x)
  use test, only : t
  type(t):: x
  x = t(42)
end subroutine
! CHECK-LABEL:   func.func @_QPtest_struct_ctor_cst(
! CHECK:  fir.call @_FortranAInitialize(

subroutine test_struct_ctor_dyn(x, i)
  use test, only : t
  type(t):: x
  integer :: i
  x = t(i)
end subroutine
! CHECK-LABEL:   func.func @_QPtest_struct_ctor_dyn(
! CHECK:  fir.call @_FortranAInitialize(

subroutine test_local_pointer()
  real, pointer :: x(:)
end subroutine
! CHECK-LABEL:   func.func @_QPtest_local_pointer() {
! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}
! CHECK:  %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
! CHECK:  %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
! CHECK:  %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK:  fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>

subroutine test_saved_pointer()
  real, pointer, save :: x(:)
end subroutine
! See check for fir.global internal @_QFtest_saved_pointerEx below.

! CHECK-LABEL:   fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
! CHECK:  %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
! CHECK:  %[[VAL_1:.*]] = fir.zero_bits i32
! CHECK:  %[[VAL_2:.*]] = fir.field_index i
! CHECK:  %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
! CHECK:  %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
! CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
! CHECK:  %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK:  %[[VAL_8:.*]] = fir.field_index x
! CHECK:  %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
! CHECK:  fir.has_value %[[VAL_9]]

! CHECK-LABEL:   fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
! CHECK:  %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : index
! CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
! CHECK:  %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK:  fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
llvm/flang/test/Lower/pointer-default-init.f90
