flang/test/Lower/default-initialization.f90

   1 ! Test default initialization of local and dummy variables (dynamic initialization)
   2 ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
   3
   4 module test_dinit
   5   type t
   6     integer :: i = 42
   7   end type
   8   type t_alloc_comp
   9     real, allocatable :: i(:)
  10   end type
  11   type tseq
  12     sequence
  13     integer :: i = 42
  14   end type
  15 contains
  16
  17 ! -----------------------------------------------------------------------------
  18 !            Test default initialization of local and dummy variables.
  19 ! -----------------------------------------------------------------------------
  20
  21   ! Test local scalar is default initialized
  22   ! CHECK-LABEL: func @_QMtest_dinitPlocal()
  23   subroutine local
  24     ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}>
  25     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
  26     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  27     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  28     type(t) :: x
  29     print *, x%i
  30   end subroutine
  31
  32   ! Test local array is default initialized
  33   ! CHECK-LABEL: func @_QMtest_dinitPlocal_array()
  34   subroutine local_array()
  35     ! CHECK: %[[x:.*]] = fir.alloca !fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>
  36     ! CHECK: %[[xshape:.*]] = fir.shape %c4{{.*}} : (index) -> !fir.shape<1>
  37     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshape]]) : (!fir.ref<!fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>>
  38     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  39     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  40     type(t) :: x(4)
  41     print *, x(2)%i
  42   end subroutine
  43
  44   ! Test allocatable component triggers default initialization of local
  45   ! scalars.
  46   ! CHECK-LABEL: func @_QMtest_dinitPlocal_alloc_comp()
  47   subroutine local_alloc_comp
  48     ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
  49     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.box<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
  50     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  51     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  52     type(t_alloc_comp) :: x
  53   end subroutine
  54
  55   ! Test function results are default initialized.
  56   ! CHECK-LABEL: func @_QMtest_dinitPresult() -> !fir.type<_QMtest_dinitTt{i:i32}>
  57   function result()
  58     ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}>
  59     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
  60     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  61     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  62     type(t) :: result
  63   end function
  64
  65   ! Test intent(out) dummies are default initialized
  66   ! CHECK-LABEL: func @_QMtest_dinitPintent_out(
  67   ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>
  68   subroutine intent_out(x)
  69     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
  70     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  71     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  72     type(t), intent(out) :: x
  73   end subroutine
  74
  75   ! Test that optional intent(out) are default initialized only when
  76   ! present.
  77   ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(
  78   ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
  79   subroutine intent_out_optional(x)
  80     ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
  81     ! CHECK: fir.if %[[isPresent]] {
  82       ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
  83       ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  84       ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
  85     ! CHECK: }
  86     type(t), intent(out), optional :: x
  87   end subroutine
  88
  89   ! Test local equivalences where one entity has default initialization
  90   ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq()
  91   subroutine local_eq()
  92     type(tseq) :: x
  93     integer :: zi
  94     ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
  95     ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
  96     ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
  97     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
  98     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
  99     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
 100     equivalence (x, zi)
 101     print *, i
 102   end subroutine
 103
 104   ! Test local equivalences with both equivalenced entities being
 105   ! default initialized. Note that the standard allow default initialization
 106   ! to be performed several times as long as the values are the same. So
 107   ! far that is what lowering is doing to stay simple.
 108   ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq2()
 109   subroutine local_eq2()
 110     type(tseq) :: x
 111     type(tseq) :: y
 112     ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
 113     ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
 114     ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
 115     ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
 116     ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
 117     ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
 118
 119
 120     ! CHECK: %[[ycoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
 121     ! CHECK: %[[y:.*]] = fir.convert %[[ycoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
 122     ! CHECK: %[[ybox:.*]] = fir.embox %[[y]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
 123     ! CHECK: %[[yboxNone:.*]] = fir.convert %[[ybox]]
 124     ! CHECK: fir.call @_FortranAInitialize(%[[yboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> none
 125     equivalence (x, y)
 126     print *, y%i
 127   end subroutine
 128
 129
 130 ! -----------------------------------------------------------------------------
 131 !        Test for local and dummy variables that must not be initialized
 132 ! -----------------------------------------------------------------------------
 133
 134   ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_alloc
 135   subroutine noinit_local_alloc
 136     ! CHECK-NOT: fir.call @_FortranAInitialize
 137     type(t), allocatable :: x
 138     ! CHECK: return
 139   end subroutine
 140
 141   ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_pointer
 142   subroutine noinit_local_pointer
 143     ! CHECK-NOT: fir.call @_FortranAInitialize
 144     type(t), pointer :: x
 145     ! CHECK: return
 146   end subroutine
 147
 148   ! CHECK-LABEL: func @_QMtest_dinitPnoinit_normal_dummy
 149   subroutine noinit_normal_dummy(x)
 150     ! CHECK-NOT: fir.call @_FortranAInitialize
 151     type(t) :: x
 152     ! CHECK: return
 153   end subroutine
 154
 155   ! CHECK-LABEL: func @_QMtest_dinitPnoinit_intentinout_dummy
 156   subroutine noinit_intentinout_dummy(x)
 157     ! CHECK-NOT: fir.call @_FortranAInitialize
 158     type(t), intent(inout) :: x
 159     ! CHECK: return
 160   end subroutine
 161
 162
 163   subroutine test_pointer_intentout(a, b)
 164     type(t), pointer, intent(out) :: a
 165     class(t), pointer, intent(out) :: b
 166   end subroutine
 167
 168 ! CHECK-LABEL: func.func @_QMtest_dinitPtest_pointer_intentout(
 169 ! CHECK-NOT: fir.call @_FortranAInitialize
 170
 171 end module
 172
 173 ! CHECK-LABEL: func.func @_QQmain
 174
 175 ! End-to-end test for debug pruposes.
 176   use test_dinit
 177   type(t) :: at
 178   call local()
 179   call local_array()
 180   at%i = 66
 181   call intent_out(at)
 182   print *, at%i
 183   at%i = 66
 184   call intent_out_optional(at)
 185   print *, at%i
 186   call intent_out_optional()
 187   call local_eq()
 188   call local_eq2()
 189 end