1! Test default initialization of local and dummy variables (dynamic initialization) 2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 3 4module 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 15contains 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) -> () 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) -> () 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) -> () 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) -> () 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) -> () 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) -> () 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) -> () 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) -> () 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) -> () 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 171end 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() 189end 190