260 lines · plain
1! Test derived type finalization2! RUN: bbc --use-desc-for-alloc=false -emit-fir -hlfir=false %s -o - | FileCheck %s3 4! Missing tests:5! - finalization within BLOCK construct6 7module derived_type_finalization8 9 type :: t110 integer :: a11 contains12 final :: t1_final13 final :: t1_final_1r14 end type15 16 type :: t217 integer, allocatable, dimension(:) :: a18 contains19 final :: t2_final20 end type21 22 type :: t323 type(t2) :: t24 end type25 26 type t427 contains28 final :: t4_final29 end type30 31contains32 33 subroutine t1_final(this)34 type(t1) :: this35 end subroutine36 37 subroutine t1_final_1r(this)38 type(t1) :: this(:)39 end subroutine40 41 subroutine t2_final(this)42 type(t2) :: this43 end subroutine44 45 ! 7.5.6.3 point 1. Finalization of LHS.46 subroutine test_lhs()47 type(t1) :: lhs, rhs48 lhs = rhs49 end subroutine50 51 subroutine test_lhs_allocatable()52 type(t1), allocatable :: lhs53 type(t1) :: rhs54 lhs = rhs55 end subroutine56 57! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs() {58! CHECK: %[[BOXREF:.*]] = fir.alloca !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>59! CHECK: %[[LHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhsElhs"}60! CHECK: %[[EMBOX:.*]] = fir.embox %[[LHS]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>61! CHECK: fir.store %[[EMBOX]] to %[[BOXREF]] : !fir.ref<!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>62! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOXREF]] : (!fir.ref<!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>) -> !fir.ref<!fir.box<none>>63! CHECK: fir.call @_FortranAAssign(%[[BOX_NONE]], {{.*}}64 65! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs_allocatable() {66! CHECK: %[[LHS:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs"}67! CHECK: %[[LHS_ADDR:.*]] = fir.alloca !fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs.addr"}68! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableErhs"}69! CHECK: %[[LHS_ADDR_LOAD:.*]] = fir.load %[[LHS_ADDR]] : !fir.ref<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>70! CHECK: %[[ADDR_I64:.*]] = fir.convert %[[LHS_ADDR_LOAD]] : (!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> i6471! CHECK: %[[C0:.*]] = arith.constant 0 : i6472! CHECK: %[[IS_NULL:.*]] = arith.cmpi ne, %[[ADDR_I64]], %[[C0]] : i6473! CHECK: fir.if %[[IS_NULL]] {74! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LHS]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.box<none>75! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()76! CHECK: }77 78 ! 7.5.6.3 point 2. Finalization on explicit deallocation.79 subroutine test_deallocate()80 type(t1), allocatable :: t81 allocate(t)82 deallocate(t)83 end subroutine84 85! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_deallocate() {86! CHECK: %[[LOCAL_T:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_deallocateEt"}87! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate88! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOCAL_T]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.ref<!fir.box<none>>89! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i3290 91 ! 7.5.6.3 point 2. Finalization of disassociated target.92 subroutine test_target_finalization()93 type(t1), pointer :: p94 allocate(p, source=t1(a=2))95 deallocate(p)96 end subroutine97 98! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_target_finalization() {99! CHECK: %[[P:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "p", uniq_name = "_QMderived_type_finalizationFtest_target_finalizationEp"}100! CHECK: %[[ADDR:.*]] = fir.alloca !fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {uniq_name = "_QMderived_type_finalizationFtest_target_finalizationEp.addr"}101! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>102! CHECK: fir.store %[[zero]] to %[[ADDR]] : !fir.ref<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>103! CHECK: fir.call @_FortranAPointerAllocateSource104! CHECK: %[[P_BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.ref<!fir.box<none>>105! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[P_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32106 107 ! 7.5.6.3 point 3. Finalize on END.108 subroutine test_end_finalization()109 type(t1) :: t110 end subroutine111 112! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization() {113! CHECK: %[[LOCAL_T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalizationEt"}114! CHECK: %[[EMBOX:.*]] = fir.embox %[[LOCAL_T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>115! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>116! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()117! CHECK: return118 119 ! test with multiple return.120 subroutine test_end_finalization2(a)121 type(t1) :: t122 logical :: a123 if (a) return124 t%a = 10125 end subroutine126 127! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization2(128! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "a"}) {129! CHECK: %[[T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalization2Et"}130! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.logical<4>>131! CHECK: %[[CONV_A:.*]] = fir.convert %[[LOAD_A]] : (!fir.logical<4>) -> i1132! CHECK: cf.cond_br %[[CONV_A]], ^bb1, ^bb2133! CHECK: ^bb1:134! CHECK: cf.br ^bb3135! CHECK: ^bb2:136! CHECK: %[[C10:.*]] = arith.constant 10 : i32137! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[T]], a : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.ref<i32>138! CHECK: fir.store %[[C10]] to %[[COORD_A]] : !fir.ref<i32>139! CHECK: cf.br ^bb3140! CHECK: ^bb3:141! CHECK: %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>142! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>143! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()144! CHECK: return145! CHECK: }146 147 function ret_type() result(ty)148 type(t1) :: ty149 end function150 151 ! 7.5.6.3 point 5. Finalization of a function reference on the RHS of an intrinsic assignment.152 subroutine test_fct_ref()153 type(t1), allocatable :: ty154 ty = ret_type()155 end subroutine156 157! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_fct_ref() {158! CHECK: %[[RESULT:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = ".result"}159! CHECK: %[[CALL_RES:.*]] = fir.call @_QMderived_type_finalizationPret_type()160! CHECK: fir.save_result %[[CALL_RES]] to %[[RESULT]] : !fir.type<_QMderived_type_finalizationTt1{a:i32}>, !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>161! CHECK: %[[EMBOX:.*]] = fir.embox %[[RESULT]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>162! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>163! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()164! CHECK: return165 166 subroutine test_finalize_intent_out(t)167 type(t1), intent(out) :: t168 end subroutine169 170! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_finalize_intent_out(171! CHECK-SAME: %[[T:.*]]: !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {fir.bindc_name = "t"}) {172! CHECK: %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>173! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>174! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}}: (!fir.box<none>) -> ()175! CHECK: return176 177 function get_t1(i)178 type(t1), pointer :: get_t1179 allocate(get_t1)180 get_t1%a = i181 end function182 183 subroutine test_nonpointer_function()184 print*, get_t1(20)185 end subroutine186 187! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_nonpointer_function() {188! CHECK: %[[TMP:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = ".result"}189! CHECK: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput190! CHECK: %[[RES:.*]] = fir.call @_QMderived_type_finalizationPget_t1(%{{.*}}) {{.*}} : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>191! CHECK: fir.save_result %[[RES]] to %[[TMP]] : !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>, !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>192! CHECK: %{{.*}} = fir.call @_FortranAioOutputDerivedType193! CHECK-NOT: fir.call @_FortranADestroy194! CHECK: %{{.*}} = fir.call @_FortranAioEndIoStatement195! CHECK: return196 197 subroutine test_avoid_double_finalization(a)198 type(t3), intent(inout) :: a199 type(t3) :: b200 b = a201 end subroutine202 203! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_avoid_double_finalization(204! CHECK: %[[b:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt3{t:!fir.type<_QMderived_type_finalizationTt2{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>}> {bindc_name = "b", uniq_name = "_QMderived_type_finalizationFtest_avoid_double_finalizationEb"}205! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMderived_type_finalizationTt3.DerivedInit) : !fir.ref<!fir.type<_QMderived_type_finalizationTt3{t:!fir.type<_QMderived_type_finalizationTt2{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>}>>206! CHECK: fir.copy %[[ADDR]] to %[[b]] no_overlap : !fir.ref<!fir.type<_QMderived_type_finalizationTt3{t:!fir.type<_QMderived_type_finalizationTt2{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>}>>207! CHECK-NOT: fir.call @_FortranADestroy208! CHECK: fir.call @_FortranAAssign(209! CHECK: fir.call @_FortranADestroy(210 211 function no_func_ret_finalize() result(ty)212 type(t1) :: ty213 ty = t1(10)214 end function215 216! CHECK-LABEL: func.func @_QMderived_type_finalizationPno_func_ret_finalize() -> !fir.type<_QMderived_type_finalizationTt1{a:i32}> {217! CHECK: fir.call @_FortranAAssign218! CHECK-NOT: fir.call @_FortranADestroy219! CHECK: return %{{.*}} : !fir.type<_QMderived_type_finalizationTt1{a:i32}>220 221 function copy(a) result(ty)222 class(t1), allocatable :: ty(:)223 integer, intent(in) :: a224 allocate(t1::ty(a))225 ty%a = 1226 end function227 228 subroutine test_avoid_double_free()229 class(*), allocatable :: up(:)230 allocate(up(10), source=copy(10))231 end subroutine232 233! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_avoid_double_free() {234! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>> {bindc_name = ".result"}235! CHECK: fir.call @_FortranAAllocatableAllocateSource(236! CHECK-NOT: fir.freemem %{{.*}} : !fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>237! CHECK: %[[RES_CONV:.*]] = fir.convert %[[RES]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>>) -> !fir.box<none>238! CHECK: fir.call @_FortranADestroy(%[[RES_CONV]]) {{.*}} : (!fir.box<none>) -> ()239 240 subroutine t4_final(this)241 type(t4) :: this242 end subroutine243 244 subroutine local_t4()245 type(t4) :: t246 end subroutine247 248! CHECK-LABEL: func.func @_QMderived_type_finalizationPlocal_t4()249! CHECK: fir.call @_FortranADestroy(%2) fastmath<contract> : (!fir.box<none>) -> ()250 251end module252 253program p254 use derived_type_finalization255 type(t1) :: t256end program257 258! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "P"} {259! CHECK-NOT: fir.call @_FortranADestroy260