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

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