[flang-commits] [flang] 8e674e8 - [flang] Deallocate INTENT(OUT) dummy allocatable components (#69164)

[via flang-commits]

Author: jeanPerier
Date: 2023-10-17T08:48:14+02:00
New Revision: 8e674e8a01314597770563041b61cc5c85680d32

URL: https://github.com/llvm/llvm-project/commit/8e674e8a01314597770563041b61cc5c85680d32
DIFF: https://github.com/llvm/llvm-project/commit/8e674e8a01314597770563041b61cc5c85680d32.diff

LOG: [flang] Deallocate INTENT(OUT) dummy allocatable components (#69164)

Non POINTER/ALLOCATABLE INTENT(OUT) dummy arguments with allocatable
components were reset without a proper deallocation if needed. Add a
call to Destroy runtime to deallocate the components on entry.

Notes:
1. The same logic is not needed on the callee side of BIND(C) call
because BIND(C) arguments cannot be derived type with allocatable
components (C1806).
2. When the argument is an INTENT(OUT) polymorphic, the dynamic type of
the actual may contain allocatable components. This case is covered by
the call to Destroy that uses dynamic type and was already inserted for
INTENT(OUT) polymorphic dummies.

Added: 
    flang/test/Lower/HLFIR/intentout-allocatable-components.f90

Modified: 
    flang/lib/Lower/ConvertVariable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 46a59b38ae6abde..895ae2451125d63 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -714,7 +714,10 @@ needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
     return true;
   // Intent(out) dummies must be finalized at runtime if their type has a
   // finalization.
-  return hasFinalization(sym);
+  // Allocatable components of INTENT(OUT) dummies must be deallocated (9.7.3.2
+  // p6). Calling finalization runtime for this works even if the components
+  // have no final procedures.
+  return hasFinalization(sym) || hasAllocatableDirectComponent(sym);
 }
 
 /// Call default initialization runtime routine to initialize \p var.
@@ -747,6 +750,9 @@ static void finalizeAtRuntime(Fortran::lower::AbstractConverter &converter,
 // is deallocated; any allocated allocatable object that is a subobject of an
 // actual argument corresponding to an INTENT(OUT) dummy argument is
 // deallocated.
+// Note that allocatable components of non-ALLOCATABLE INTENT(OUT) dummy
+// arguments are dealt with needDummyIntentoutFinalization (finalization runtime
+// is called to reach the intended component deallocation effect).
 static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
                                 const Fortran::lower::pft::Variable &var,
                                 Fortran::lower::SymMap &symMap) {

diff  --git a/flang/test/Lower/HLFIR/intentout-allocatable-components.f90 b/flang/test/Lower/HLFIR/intentout-allocatable-components.f90
new file mode 100644
index 000000000000000..932fafd322a3e3a
--- /dev/null
+++ b/flang/test/Lower/HLFIR/intentout-allocatable-components.f90
@@ -0,0 +1,32 @@
+! Test that allocatable components of non pointer/non allocatable INTENT(OUT)
+! dummy arguments are deallocated.
+! RUN: bbc -emit-hlfir -polymorphic-type %s -o - -I nowhere | FileCheck %s
+
+subroutine test_intentout_component_deallocate(a)
+  type :: t
+    integer, allocatable :: x
+  end type
+  type(t), intent(out) :: a
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_intentout_component_deallocate(
+! CHECK-SAME:      %[[VAL_0:.*]]: !fir.ref<!fir.type<_QFtest_intentout_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_out>, uniq_name = "_QFtest_intentout_component_deallocateEa"}
+! CHECK:  %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#1 : (!fir.ref<!fir.type<_QFtest_intentout_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>) -> !fir.box<!fir.type<_QFtest_intentout_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.type<_QFtest_intentout_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>) -> !fir.box<none>
+! CHECK:  %[[VAL_4:.*]] = fir.call @_FortranADestroy(%[[VAL_3]]) fastmath<contract> : (!fir.box<none>) -> none
+
+subroutine test_intentout_optional_component_deallocate(a)
+  type :: t
+    integer, allocatable :: x
+  end type
+  type(t), optional, intent(out) :: a
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_intentout_optional_component_deallocate(
+! CHECK-SAME:      %[[VAL_0:.*]]: !fir.ref<!fir.type<_QFtest_intentout_optional_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_out, optional>, uniq_name = "_QFtest_intentout_optional_component_deallocateEa"}
+! CHECK:  %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#1 : (!fir.ref<!fir.type<_QFtest_intentout_optional_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>) -> i1
+! CHECK:  fir.if %[[VAL_2]] {
+! CHECK:    %[[VAL_3:.*]] = fir.embox %[[VAL_1]]#1 : (!fir.ref<!fir.type<_QFtest_intentout_optional_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>) -> !fir.box<!fir.type<_QFtest_intentout_optional_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>
+! CHECK:    %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.type<_QFtest_intentout_optional_component_deallocateTt{x:!fir.box<!fir.heap<i32>>}>>) -> !fir.box<none>
+! CHECK:    %[[VAL_5:.*]] = fir.call @_FortranADestroy(%[[VAL_4]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK:  }