flang/test/Lower/derived-type-finalization.f90

   1 ! Test derived type finalization
   2 ! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
   3
   4 ! Missing tests:
   5 ! - finalization within BLOCK construct
   6
   7 module derived_type_finalization
   8
   9   type :: t1
  10     integer :: a
  11   contains
  12     final :: t1_final
  13   end type
  14
  15   type :: t2
  16     integer, allocatable, dimension(:) :: a
  17   contains
  18     final :: t2_final
  19   end type
  20
  21   type :: t3
  22     type(t2) :: t
  23   end type
  24
  25 contains
  26
  27   subroutine t1_final(this)
  28     type(t1) :: this
  29   end subroutine
  30
  31   subroutine t2_final(this)
  32     type(t2) :: this
  33   end subroutine
  34
  35   ! 7.5.6.3 point 1. Finalization of LHS.
  36   subroutine test_lhs()
  37     type(t1) :: lhs, rhs
  38     lhs = rhs
  39   end subroutine
  40
  41   subroutine test_lhs_allocatable()
  42     type(t1), allocatable :: lhs
  43     type(t1) :: rhs
  44     lhs = rhs
  45   end subroutine
  46
  47 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs() {
  48 ! CHECK: %[[LHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhsElhs"}
  49 ! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhsErhs"}
  50 ! CHECK: %[[EMBOX:.*]] = fir.embox %[[LHS]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
  51 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
  52 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
  53
  54 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs_allocatable() {
  55 ! 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"}
  56 ! CHECK: %[[LHS_ADDR:.*]] = fir.alloca !fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs.addr"}
  57 ! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableErhs"}
  58 ! CHECK: %[[LHS_ADDR_LOAD:.*]] = fir.load %[[LHS_ADDR]] : !fir.ref<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>
  59 ! CHECK: %[[ADDR_I64:.*]] = fir.convert %[[LHS_ADDR_LOAD]] : (!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> i64
  60 ! CHECK: %[[C0:.*]] = arith.constant 0 : i64
  61 ! CHECK: %[[IS_NULL:.*]] = arith.cmpi ne, %[[ADDR_I64]], %[[C0]] : i64
  62 ! CHECK: fir.if %[[IS_NULL]] {
  63 ! CHECK:   %[[BOX_NONE:.*]] = fir.convert %[[LHS]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.box<none>
  64 ! CHECK:   %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
  65 ! CHECK: }
  66
  67   ! 7.5.6.3 point 2. Finalization on explicit deallocation.
  68   subroutine test_deallocate()
  69     type(t1), allocatable :: t
  70     allocate(t)
  71     deallocate(t)
  72   end subroutine
  73
  74 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_deallocate() {
  75 ! 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"}
  76 ! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate
  77 ! 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>>
  78 ! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
  79
  80   ! 7.5.6.3 point 2. Finalization of disassociated target.
  81   subroutine test_target_finalization()
  82     type(t1), pointer :: p
  83     allocate(p, source=t1(a=2))
  84     deallocate(p)
  85   end subroutine
  86
  87 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_target_finalization() {
  88 ! 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"}
  89 ! CHECK: fir.call @_FortranAInitialize
  90 ! CHECK: fir.call @_FortranAPointerAllocateSource
  91 ! 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>>
  92 ! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[P_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
  93
  94   ! 7.5.6.3 point 3. Finalize on END.
  95   subroutine test_end_finalization()
  96     type(t1) :: t
  97   end subroutine
  98
  99 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization() {
 100 ! CHECK: %[[LOCAL_T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalizationEt"}
 101 ! CHECK: %[[EMBOX:.*]] = fir.embox %[[LOCAL_T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 102 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 103 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
 104 ! CHECK: return
 105
 106   ! test with multiple return.
 107   subroutine test_end_finalization2(a)
 108     type(t1) :: t
 109     logical :: a
 110     if (a) return
 111     t%a = 10
 112   end subroutine
 113
 114 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization2(
 115 ! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "a"}) {
 116 ! CHECK:   %[[T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalization2Et"}
 117 ! CHECK:   %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.logical<4>>
 118 ! CHECK:   %[[CONV_A:.*]] = fir.convert %[[LOAD_A]] : (!fir.logical<4>) -> i1
 119 ! CHECK:   cf.cond_br %[[CONV_A]], ^bb1, ^bb2
 120 ! CHECK: ^bb1:
 121 ! CHECK:   cf.br ^bb3
 122 ! CHECK: ^bb2:
 123 ! CHECK:   %[[C10:.*]] = arith.constant 10 : i32
 124 ! CHECK:   %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMderived_type_finalizationTt1{a:i32}>
 125 ! CHECK:   %[[COORD_A:.*]] = fir.coordinate_of %[[T]], %[[FIELD_A]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>, !fir.field) -> !fir.ref<i32>
 126 ! CHECK:   fir.store %[[C10]] to %[[COORD_A]] : !fir.ref<i32>
 127 ! CHECK:   cf.br ^bb3
 128 ! CHECK: ^bb3:
 129 ! CHECK:   %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 130 ! CHECK:   %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 131 ! CHECK:   %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
 132 ! CHECK:   return
 133 ! CHECK: }
 134
 135   function ret_type() result(ty)
 136     type(t1) :: ty
 137   end function
 138
 139   ! 7.5.6.3 point 5. Finalization of a function reference on the RHS of an intrinsic assignment.
 140   subroutine test_fct_ref()
 141     type(t1), allocatable :: ty
 142     ty = ret_type()
 143   end subroutine
 144
 145 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_fct_ref() {
 146 ! CHECK: %[[RESULT:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = ".result"}
 147 ! CHECK: %[[CALL_RES:.*]] = fir.call @_QMderived_type_finalizationPret_type()
 148 ! CHECK: fir.save_result %[[CALL_RES]] to %[[RESULT]] : !fir.type<_QMderived_type_finalizationTt1{a:i32}>, !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 149 ! CHECK: %[[EMBOX:.*]] = fir.embox %[[RESULT]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 150 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 151 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
 152 ! CHECK: return
 153
 154   subroutine test_finalize_intent_out(t)
 155     type(t1), intent(out) :: t
 156   end subroutine
 157
 158 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_finalize_intent_out(
 159 ! CHECK-SAME: %[[T:.*]]: !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {fir.bindc_name = "t"}) {
 160 ! CHECK: %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 161 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 162 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}}: (!fir.box<none>) -> none
 163 ! CHECK: return
 164
 165   function get_t1(i)
 166     type(t1), pointer :: get_t1
 167     allocate(get_t1)
 168     get_t1%a = i
 169   end function
 170
 171   subroutine test_nonpointer_function()
 172     print*, get_t1(20)
 173   end subroutine
 174
 175 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_nonpointer_function() {
 176 ! CHECK: %[[TMP:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = ".result"}
 177 ! CHECK: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput
 178 ! CHECK: %[[RES:.*]] = fir.call @_QMderived_type_finalizationPget_t1(%{{.*}}) {{.*}} : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>
 179 ! 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}>>>>
 180 ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor
 181 ! CHECK-NOT: %{{.*}} = fir.call @_FortranADestroy
 182 ! CHECK: %{{.*}} = fir.call @_FortranAioEndIoStatement
 183 ! CHECK: return
 184
 185   subroutine test_avoid_double_finalization(a)
 186     type(t3), intent(inout) :: a
 187     type(t3)                :: b
 188     b = a
 189   end subroutine
 190
 191 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_avoid_double_finalization(
 192 ! CHECK: fir.call @_FortranAInitialize(
 193 ! CHECK-NOT: %{{.*}} = fir.call @_FortranADestroy
 194 ! CHECK: %{{.*}} = fir.call @_FortranAAssign(
 195 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(
 196
 197   function no_func_ret_finalize() result(ty)
 198     type(t1) :: ty
 199     ty = t1(10)
 200   end function
 201
 202 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPno_func_ret_finalize() -> !fir.type<_QMderived_type_finalizationTt1{a:i32}> {
 203 ! CHECK: %{{.*}} = fir.call @_FortranADestroy
 204 ! CHECK: return %{{.*}} : !fir.type<_QMderived_type_finalizationTt1{a:i32}>
 205
 206 end module
 207
 208 program p
 209   use derived_type_finalization
 210   type(t1) :: t
 211   if (t%a == 10) return
 212   print *, 'end of program'
 213 end program
 214
 215 ! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "p"} {
 216 ! CHECK: %[[T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QFEt"}
 217 ! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
 218 ! CHECK: ^bb1:
 219 ! CHECK:  %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 220 ! CHECK:  %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 221 ! CHECK:  %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
 222 ! CHECK:  return
 223 ! CHECK: ^bb2:
 224 ! CHECK:  %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
 225 ! CHECK:  %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
 226 ! CHECK:  %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
 227 ! CHECK:  return