From e18b5e4a38850a1ecc493c6a0652b8b67a5cc9b7 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier@nvidia.com>
Date: Mon, 16 Oct 2023 01:17:30 -0700
Subject: [PATCH] [flang] Deallocate INTENT(OUT) dummy allocatable components

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.
---
 flang/lib/Lower/ConvertVariable.cpp           |  8 ++++-
 .../intentout-allocatable-components.f90      | 32 +++++++++++++++++++
 2 files changed, 39 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Lower/HLFIR/intentout-allocatable-components.f90

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 46a59b38ae6ab..895ae2451125d 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 0000000000000..932fafd322a3e
--- /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:  }