1! Test automatic deallocation of local allocatables as described in 2! Fortran 2018 standard 9.7.3.2 point 2. and 3. 3 4! RUN: bbc -emit-hlfir -o - %s | FileCheck %s 5module dtypedef 6 type must_finalize 7 integer :: i 8 contains 9 final :: finalize 10 end type 11 type contain_must_finalize 12 type(must_finalize) :: a 13 end type 14 interface 15 subroutine finalize(a) 16 import :: must_finalize 17 type(must_finalize), intent(inout) :: a 18 end subroutine 19 end interface 20 real, allocatable :: x 21end module 22 23subroutine simple() 24 real, allocatable :: x 25 allocate(x) 26 call bar() 27end subroutine 28! CHECK-LABEL: func.func @_QPsimple() { 29! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFsimpleEx" 30! CHECK: fir.call @_QPbar 31! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>> 32! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32> 33! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<f32>) -> i64 34! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i64 35! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_8]], %[[VAL_9]] : i64 36! CHECK: fir.if %[[VAL_10]] { 37! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>> 38! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32> 39! CHECK: fir.freemem %[[VAL_12]] : !fir.heap<f32> 40! CHECK: %[[VAL_13:.*]] = fir.zero_bits !fir.heap<f32> 41! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>> 42! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>> 43! CHECK: } 44 45subroutine multiple_return(cdt) 46 real, allocatable :: x 47 logical :: cdt 48 allocate(x) 49 if (cdt) return 50 call bar() 51end subroutine 52! CHECK-LABEL: func.func @_QPmultiple_return( 53! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2 54! CHECK: ^bb1: 55! CHECK-NOT: fir.freemem 56! CHECK: cf.br ^bb3 57! CHECK: ^bb2: 58! CHECK: fir.call @_QPbar 59! CHECK: cf.br ^bb3 60! CHECK: ^bb3: 61! CHECK: fir.if {{.*}} { 62! CHECK: fir.freemem 63! CHECK: } 64! CHECK: return 65 66subroutine derived() 67 use dtypedef, only : must_finalize 68 type(must_finalize), allocatable :: x 69 allocate(x) 70 call bar() 71end subroutine 72! CHECK-LABEL: func.func @_QPderived() { 73! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFderivedEx" 74! CHECK: fir.call @_QPbar 75! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>> 76! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>) -> !fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>> 77! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>) -> i64 78! CHECK: %[[VAL_14:.*]] = arith.constant 0 : i64 79! CHECK: %[[VAL_15:.*]] = arith.cmpi ne, %[[VAL_13]], %[[VAL_14]] : i64 80! CHECK: fir.if %[[VAL_15]] { 81! CHECK: %[[VAL_16:.*]] = arith.constant false 82! CHECK: %[[VAL_17:.*]] = fir.absent !fir.box<none> 83! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>>) -> !fir.ref<!fir.box<none>> 84! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAAllocatableDeallocate(%[[VAL_20]], %[[VAL_16]], %[[VAL_17]], %{{.*}}, %{{.*}}) 85! CHECK: } 86 87subroutine derived2() 88 use dtypedef, only : contain_must_finalize 89 type(contain_must_finalize), allocatable :: x 90 allocate(x) 91end subroutine 92! CHECK-LABEL: func.func @_QPderived2( 93! CHECK: fir.if {{.*}} { 94! CHECK: fir.call @_FortranAAllocatableDeallocate 95! CHECK: } 96 97subroutine simple_block() 98 block 99 real, allocatable :: x 100 allocate(x) 101 call bar() 102 end block 103 call bar_after_block() 104end subroutine 105! CHECK-LABEL: func.func @_QPsimple_block( 106! CHECK: fir.call @_QPbar 107! CHECK: fir.if {{.*}} { 108! CHECK: fir.freemem 109! CHECK: } 110! CHECK: fir.call @_QPbar_after_block 111 112subroutine mutiple_return_block(cdt) 113 logical :: cdt 114 block 115 real, allocatable :: x 116 allocate(x) 117 if (cdt) return 118 call bar() 119 end block 120 call bar_after_block() 121end subroutine 122! CHECK-LABEL: func.func @_QPmutiple_return_block( 123! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2 124! CHECK: ^bb1: 125! CHECK: fir.if {{.*}} { 126! CHECK: fir.freemem 127! CHECK: } 128! CHECK: cf.br ^bb3 129! CHECK: ^bb2: 130! CHECK: fir.call @_QPbar 131! CHECK: fir.if {{.*}} { 132! CHECK: fir.freemem 133! CHECK: } 134! CHECK: fir.call @_QPbar_after_block 135! CHECK: cf.br ^bb3 136! CHECK: ^bb3: 137! CHECK: return 138 139 140subroutine derived_block() 141 use dtypedef, only : must_finalize 142 block 143 type(must_finalize), allocatable :: x 144 allocate(x) 145 call bar() 146 end block 147 call bar_after_block() 148end subroutine 149! CHECK-LABEL: func.func @_QPderived_block( 150! CHECK: fir.call @_QPbar 151! CHECK: fir.if {{.*}} { 152! CHECK: fir.call @_FortranAAllocatableDeallocate 153! CHECK: } 154! CHECK: fir.call @_QPbar_after_block 155 156subroutine derived_block2() 157 use dtypedef, only : contain_must_finalize 158 call bar() 159 block 160 type(contain_must_finalize), allocatable :: x 161 allocate(x) 162 end block 163 call bar_after_block() 164end subroutine 165! CHECK-LABEL: func.func @_QPderived_block2( 166! CHECK: fir.call @_QPbar 167! CHECK: fir.if {{.*}} { 168! CHECK: fir.call @_FortranAAllocatableDeallocate 169! CHECK: } 170! CHECK: fir.call @_QPbar_after_block 171 172subroutine no_dealloc_saved() 173 real, allocatable, save :: x 174 allocate(x) 175end subroutine 176! CHECK-LABEL: func.func @_QPno_dealloc_save 177! CHECK-NOT: freemem 178! CHECK-NOT: Deallocate 179! CHECK: return 180 181subroutine no_dealloc_block_saved() 182 block 183 real, allocatable, save :: x 184 allocate(x) 185 end block 186end subroutine 187! CHECK-LABEL: func.func @_QPno_dealloc_block_saved 188! CHECK-NOT: freemem 189! CHECK-NOT: Deallocate 190! CHECK: return 191 192function no_dealloc_result() result(x) 193 real, allocatable :: x 194 allocate(x) 195end function 196! CHECK-LABEL: func.func @_QPno_dealloc_result 197! CHECK-NOT: freemem 198! CHECK-NOT: Deallocate 199! CHECK: return 200 201subroutine no_dealloc_dummy(x) 202 real, allocatable :: x 203 allocate(x) 204end subroutine 205! CHECK-LABEL: func.func @_QPno_dealloc_dummy 206! CHECK-NOT: freemem 207! CHECK-NOT: Deallocate 208! CHECK: return 209 210subroutine no_dealloc_module_var() 211 use dtypedef, only : x 212 allocate(x) 213end subroutine 214! CHECK-LABEL: func.func @_QPno_dealloc_module_var 215! CHECK-NOT: freemem 216! CHECK-NOT: Deallocate 217! CHECK: return 218 219subroutine no_dealloc_host_assoc() 220 real, allocatable :: x 221 call internal() 222contains 223 subroutine internal() 224 allocate(x) 225 end subroutine 226end subroutine 227! CHECK-LABEL: func.func private @_QFno_dealloc_host_assocPinternal 228! CHECK-NOT: freemem 229! CHECK-NOT: Deallocate 230! CHECK: return 231 232subroutine no_dealloc_pointer(x) 233 real, pointer :: x 234 allocate(x) 235end subroutine 236! CHECK-LABEL: func.func @_QPno_dealloc_pointer 237! CHECK-NOT: freemem 238! CHECK-NOT: Deallocate 239! CHECK: return 240