flang/test/Lower/pointer-default-init.f90

   1 ! Test that pointer and pointer components are always initialized to a
   2 ! clean NULL() status. This is required by f18 runtime to do pointer
   3 ! association with a RHS with an undefined association status from a
   4 ! Fortran point of view.
   5 ! RUN: bbc -emit-fir -hlfir=false -I nw %s -o - | FileCheck %s
   6
   7 module test
   8   type t
   9     integer :: i
  10     real, pointer :: x(:)
  11   end type
  12
  13   real, pointer :: test_module_pointer(:)
  14 ! CHECK-LABEL:   fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
  15 ! CHECK:  %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
  16 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : index
  17 ! CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
  18 ! CHECK:  %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  19 ! CHECK:  fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
  20
  21   type(t) :: test_module_var
  22 ! CHECK-LABEL:   fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
  23 ! CHECK:  %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
  24 ! CHECK:  %[[VAL_1:.*]] = fir.zero_bits i32
  25 ! CHECK:  %[[VAL_2:.*]] = fir.field_index i
  26 ! CHECK:  %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
  27 ! CHECK:  %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
  28 ! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
  29 ! CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
  30 ! CHECK:  %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  31 ! CHECK:  %[[VAL_8:.*]] = fir.field_index x
  32 ! CHECK:  %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
  33 ! CHECK:  fir.has_value %[[VAL_9]]
  34 end module
  35
  36 subroutine test_local()
  37   use test, only : t
  38   type(t) :: x
  39 end subroutine
  40 ! CHECK-LABEL:   func.func @_QPtest_local() {
  41 ! CHECK:  fir.call @_FortranAInitialize(
  42
  43 subroutine test_saved()
  44   use test, only : t
  45   type(t), save :: x
  46 end subroutine
  47 ! See check for fir.global internal @_QFtest_savedEx below.
  48
  49 subroutine test_alloc(x)
  50   use test, only : t
  51   type(t), allocatable :: x
  52   allocate(x)
  53 end subroutine
  54 ! CHECK-LABEL:   func.func @_QPtest_alloc(
  55 ! CHECK:  fir.call @_FortranAAllocatableAllocate
  56
  57 subroutine test_intentout(x)
  58   use test, only : t
  59   type(t), intent(out):: x
  60 end subroutine
  61 ! CHECK-LABEL:   func.func @_QPtest_intentout(
  62 ! CHECK-NOT:           fir.call @_FortranAInitialize(
  63 ! CHECK:  return
  64
  65 subroutine test_struct_ctor_cst(x)
  66   use test, only : t
  67   type(t):: x
  68   x = t(42)
  69 end subroutine
  70 ! CHECK-LABEL:   func.func @_QPtest_struct_ctor_cst(
  71 ! CHECK:  fir.call @_FortranAInitialize(
  72
  73 subroutine test_struct_ctor_dyn(x, i)
  74   use test, only : t
  75   type(t):: x
  76   integer :: i
  77   x = t(i)
  78 end subroutine
  79 ! CHECK-LABEL:   func.func @_QPtest_struct_ctor_dyn(
  80 ! CHECK:  fir.call @_FortranAInitialize(
  81
  82 subroutine test_local_pointer()
  83   real, pointer :: x(:)
  84 end subroutine
  85 ! CHECK-LABEL:   func.func @_QPtest_local_pointer() {
  86 ! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}
  87 ! CHECK:  %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
  88 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
  89 ! CHECK:  %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
  90 ! CHECK:  %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  91 ! CHECK:  fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  92
  93 subroutine test_saved_pointer()
  94   real, pointer, save :: x(:)
  95 end subroutine
  96 ! See check for fir.global internal @_QFtest_saved_pointerEx below.
  97
  98 ! CHECK-LABEL:   fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
  99 ! CHECK:  %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
 100 ! CHECK:  %[[VAL_1:.*]] = fir.zero_bits i32
 101 ! CHECK:  %[[VAL_2:.*]] = fir.field_index i
 102 ! CHECK:  %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
 103 ! CHECK:  %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
 104 ! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
 105 ! CHECK:  %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
 106 ! CHECK:  %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
 107 ! CHECK:  %[[VAL_8:.*]] = fir.field_index x
 108 ! CHECK:  %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
 109 ! CHECK:  fir.has_value %[[VAL_9]]
 110
 111 ! CHECK-LABEL:   fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
 112 ! CHECK:  %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
 113 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : index
 114 ! CHECK:  %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 115 ! CHECK:  %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
 116 ! CHECK:  fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>