183 lines · plain
1! Test default initialization of local and dummy variables (dynamic initialization)2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s3 4module test_dinit5 type t6 integer :: i = 427 end type8 type t_alloc_comp9 real, allocatable :: i(:)10 end type11 type tseq12 sequence13 integer :: i = 4214 end type15contains16 17! -----------------------------------------------------------------------------18! Test default initialization of local and dummy variables.19! -----------------------------------------------------------------------------20 21 ! Test local scalar is default initialized22 ! CHECK-LABEL: func @_QMtest_dinitPlocal()23 subroutine local24 !CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}> {bindc_name = "x", uniq_name = "_QMtest_dinitFlocalEx"}25 !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>26 !CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>27 type(t) :: x28 print *, x%i29 end subroutine30 31 ! Test local array is default initialized32 ! CHECK-LABEL: func @_QMtest_dinitPlocal_array()33 subroutine local_array()34 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>35 ! CHECK: %[[xshape:.*]] = fir.shape %c4{{.*}} : (index) -> !fir.shape<1>36 ! 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}>>>37 ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]38 ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> ()39 type(t) :: x(4)40 print *, x(2)%i41 end subroutine42 43 ! Test allocatable component triggers default initialization of local44 ! scalars.45 ! CHECK-LABEL: func @_QMtest_dinitPlocal_alloc_comp()46 subroutine local_alloc_comp47 !CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}> {bindc_name = "x", uniq_name = "_QMtest_dinitFlocal_alloc_compEx"}48 !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt_alloc_comp.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>49 !CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>50 type(t_alloc_comp) :: x51 end subroutine52 53 ! Test function results are default initialized.54 ! CHECK-LABEL: func @_QMtest_dinitPresult() -> !fir.type<_QMtest_dinitTt{i:i32}>55 function result()56 !CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}> {bindc_name = "result", uniq_name = "_QMtest_dinitFresultEresult"}57 !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>58 !CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>59 type(t) :: result60 end function61 62 ! Test intent(out) dummies are default initialized63 ! CHECK-LABEL: func @_QMtest_dinitPintent_out(64 ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>65 subroutine intent_out(x)66 !CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTt.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>67 !CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>, !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>68 type(t), intent(out) :: x69 end subroutine70 71 ! Test that optional intent(out) are default initialized only when72 ! present.73 ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(74 ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})75 subroutine intent_out_optional(x)76 ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i177 ! CHECK: fir.if %[[isPresent]] {78 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>79 ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]80 ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.ref<i8>, i32) -> ()81 ! CHECK: }82 type(t), intent(out), optional :: x83 end subroutine84 85 ! Test local equivalences where one entity has default initialization86 ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq()87 subroutine local_eq()88 type(tseq) :: x89 integer :: zi90 ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>91 ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>92 ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>93 ! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>94 ! CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>95 equivalence (x, zi)96 print *, i97 end subroutine98 99 ! Test local equivalences with both equivalenced entities being100 ! default initialized. Note that the standard allow default initialization101 ! to be performed several times as long as the values are the same. So102 ! far that is what lowering is doing to stay simple.103 ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq2()104 subroutine local_eq2()105 type(tseq) :: x106 type(tseq) :: y107 ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>108 ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>109 ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>110 ! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>111 ! CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>112 113 114 ! CHECK: %[[ycoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>115 ! CHECK: %[[y:.*]] = fir.convert %[[ycoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>116 ! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtest_dinitTtseq.DerivedInit) : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>117 ! CHECK: fir.copy %[[ADDR]] to %[[y]] no_overlap : !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>, !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>118 equivalence (x, y)119 print *, y%i120 end subroutine121 122 123! -----------------------------------------------------------------------------124! Test for local and dummy variables that must not be initialized125! -----------------------------------------------------------------------------126 127 ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_alloc128 subroutine noinit_local_alloc129 ! CHECK-NOT: fir.call @_FortranAInitialize130 type(t), allocatable :: x131 ! CHECK: return132 end subroutine133 134 ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_pointer135 subroutine noinit_local_pointer136 ! CHECK-NOT: fir.call @_FortranAInitialize137 type(t), pointer :: x138 ! CHECK: return139 end subroutine140 141 ! CHECK-LABEL: func @_QMtest_dinitPnoinit_normal_dummy142 subroutine noinit_normal_dummy(x)143 ! CHECK-NOT: fir.call @_FortranAInitialize144 type(t) :: x145 ! CHECK: return146 end subroutine147 148 ! CHECK-LABEL: func @_QMtest_dinitPnoinit_intentinout_dummy149 subroutine noinit_intentinout_dummy(x)150 ! CHECK-NOT: fir.call @_FortranAInitialize151 type(t), intent(inout) :: x152 ! CHECK: return153 end subroutine154 155 156 subroutine test_pointer_intentout(a, b)157 type(t), pointer, intent(out) :: a158 class(t), pointer, intent(out) :: b159 end subroutine160 161! CHECK-LABEL: func.func @_QMtest_dinitPtest_pointer_intentout(162! CHECK-NOT: fir.call @_FortranAInitialize163 164end module165 166! CHECK-LABEL: func.func @_QQmain167 168! End-to-end test for debug pruposes.169 use test_dinit170 type(t) :: at171 call local()172 call local_array()173 at%i = 66174 call intent_out(at)175 print *, at%i176 at%i = 66177 call intent_out_optional(at)178 print *, at%i179 call intent_out_optional()180 call local_eq()181 call local_eq2()182end183