[flang] Deallocate intent(out) allocatables

[clementval]

Summary

From Fortran 2018 standard 9.7.3.2 point 6:
When a procedure is invoked, any allocated allocatable object that is an actual
argument corresponding to an INTENT (OUT) allocatable dummy argument is
deallocated; any allocated allocatable object that is a subobject of an actual
argument corresponding to an INTENT (OUT) dummy argument is deallocated.

Deallocation is done on the callee side. For BIND(C) procedure, the deallocation
is also done on the caller side.

[jeanPerier]

any allocated allocatable object that is a subobject of an actual argument corresponding to an INTENT (OUT) dummy argument is deallocated

Did you intend to implement this part ? I do not think the patch covers it (I would expect something checking if some non allocatable derived type object with allocatable components are intent(out)).

Also, is this possible for OPTIONAL allocatable to be intent(out) ? If so, the deallocation may have to be conditional for optionals.

Otherwise the logic looks good to me.

[clementval]

In D133348#3771864, @jeanPerier wrote:

any allocated allocatable object that is a subobject of an actual argument corresponding to an INTENT (OUT) dummy argument is deallocated

Did you intend to implement this part ? I do not think the patch covers it (I would expect something checking if some non allocatable derived type object with allocatable components are intent(out)).

It is implemented on the callee side already with the default initialization of the derived type.

module mod1
type t1
  integer, allocatable :: a(:)
end type
contains
  subroutine sub(d)
    type(t1), intent(out) :: d
    if (allocated(d%a)) print*,'fail'
  end
end

use mod1
type(t1) :: t

allocate(t%a(10))
call sub(t)
end

This small test is already passing. I'll update the caller side with bind(c).

Also, is this possible for OPTIONAL allocatable to be intent(out) ? If so, the deallocation may have to be conditional for optionals.

Yes it is. I'll add the condition for that.

Otherwise the logic looks good to me.

[clementval]

Handle allocatable components and optional allocatables

[jeanPerier]

flang/lib/Lower/ConvertVariable.cpp

628–631

I do not remember the logic of genDeallocateBox, is this OK to call if the allocatable is unallocated ? Otherwise, some more conditional logic is probably needed here.

flang/test/Lower/intentout-deallocate.f90

34

Reading the standard again, I think bind(c) procedure cannot have a derived type with allocatable component.

• C1554: "If proc-language-binding-spec is specified for a procedure, each of its dummy arguments shall be an interoperable procedure (18.3.6) or a variable that is interoperable (18.3.4, 18.3.5), assumed-shape, assumedrank, assumed-type, of type CHARACTER with assumed length, or that has the ALLOCATABLE or POINTER attribute."

• 18.3.3 point 2: "A derived type is interoperable with a C structure type if and only if the derived type has the BIND attribute [....]"

• C1806: "Each component of a derived type with the BIND attribute shall be a nonpointer, nonallocatable data component with interoperable type and type parameters."

My conclusion of this is that this is illegal, and you do not need to care about INTENT(OUT) derived types with allocatable components on the caller side for BIND(C). gfortran rejects this, but not ifort (and flang semantics currently).

Since the appositions in C1554 make it highly unreadable to me, you probably want to double check this with @klausler.

[klausler]

flang/test/Lower/intentout-deallocate.f90

34

C1554 literally implies that the type of a dummy argument variable is irrelevant in several cases (assumed-shape, assumed-rank, allocatable, pointer) and that is difficult for me to understand as well. However, it is possible that the context intends for C1554 to apply only to procedure definitions, not interfaces, since it's in subclause 15.6..

[clementval]

Remove non-conform tests

[clementval]

flang/lib/Lower/ConvertVariable.cpp

628–631

Yes it is fine to call it with an unallocated box.

flang/test/Lower/intentout-deallocate.f90

34

I removed those tests.

[jeanPerier]

LGTM

flang/include/flang/Lower/Allocatable.h

 /// Lower an allocate statement to fir.
 void genAllocateStmt(AbstractConverter &converter,
                      const parser::AllocateStmt &stmt, mlir::Location loc);
 
 /// Lower a deallocate statement to fir.
 void genDeallocateStmt(AbstractConverter &converter,
                        const parser::DeallocateStmt &stmt, mlir::Location loc);
 
+void genDeallocateBox(AbstractConverter &converter,
+                      const fir::MutableBoxValue &box, mlir::Location loc);
+
 /// Create a MutableBoxValue for an allocatable or pointer entity.
 /// If the variables is a local variable that is not a dummy, it will be
 /// initialized to unallocated/diassociated status.
 fir::MutableBoxValue createMutableBox(AbstractConverter &converter,
                                       mlir::Location loc,
                                       const pft::Variable &var,
                                       mlir::Value boxAddr,
                                       mlir::ValueRange nonDeferredParams);

flang/include/flang/Lower/CallInterface.h

public:
   /// It describe how the entity is plugged in the interface
   struct PassedEntity {
     /// Is the dummy argument optional ?
     bool isOptional() const;
     /// Can the argument be modified by the callee ?
     bool mayBeModifiedByCall() const;
     /// Can the argument be read by the callee ?
     bool mayBeReadByCall() const;
+    /// Is the argument INTENT(OUT)
+    bool isIntentOut() const;
     /// How entity is passed by.
     PassEntityBy passBy;
     /// What is the entity (SymbolRef for callee/ActualArgument* for caller)
     /// What is the related mlir::func::FuncOp argument(s) (mlir::Value for
     /// callee / index for the caller).
     FortranEntity entity;
     FirValue firArgument;
     FirValue firLength; /* only for AddressAndLength */

flang/lib/Lower/Allocatable.cpp

static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
   // Use runtime calls to deallocate descriptor cases. Sync MutableBoxValue
   // with its descriptor before and after calls if needed.
   errorManager.genStatCheck(builder, loc);
   mlir::Value stat = genRuntimeDeallocate(builder, loc, box, errorManager);
   fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
   errorManager.assignStat(builder, loc, stat);
 }
 
+void Fortran::lower::genDeallocateBox(
+    Fortran::lower::AbstractConverter &converter,
+    const fir::MutableBoxValue &box, mlir::Location loc) {
+  const Fortran::lower::SomeExpr *statExpr = nullptr;
+  const Fortran::lower::SomeExpr *errMsgExpr = nullptr;
+  ErrorManager errorManager;
+  errorManager.init(converter, loc, statExpr, errMsgExpr);
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  genDeallocate(builder, loc, box, errorManager);
+}
+
 void Fortran::lower::genDeallocateStmt(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::DeallocateStmt &stmt, mlir::Location loc) {
   const Fortran::lower::SomeExpr *statExpr = nullptr;
   const Fortran::lower::SomeExpr *errMsgExpr = nullptr;
   for (const Fortran::parser::StatOrErrmsg &statOrErr :
        std::get<std::list<Fortran::parser::StatOrErrmsg>>(stmt.t))
     std::visit(Fortran::common::visitors{

flang/lib/Lower/CallInterface.cpp

bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeModifiedByCall()
   return characteristics->GetIntent() != Fortran::common::Intent::In;
 }
 template <typename T>
 bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeReadByCall() const {
   if (!characteristics)
     return true;
   return characteristics->GetIntent() != Fortran::common::Intent::Out;
 }
+template <typename T>
+bool Fortran::lower::CallInterface<T>::PassedEntity::isIntentOut() const {
+  if (!characteristics)
+    return true;
+  return characteristics->GetIntent() == Fortran::common::Intent::Out;
+}
 
 template <typename T>
 void Fortran::lower::CallInterface<T>::determineInterface(
     bool isImplicit,
     const Fortran::evaluate::characteristics::Procedure &procedure) {
   CallInterfaceImpl<T> impl(*this);
   if (isImplicit)
     impl.buildImplicitInterface(procedure);

flang/lib/Lower/ConvertExpr.cpp

for (const Fortran::lower::CallInterface<
         }
         // Passing a POINTER to a POINTER, or an ALLOCATABLE to an ALLOCATABLE.
         fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
         mlir::Value irBox =
             fir::factory::getMutableIRBox(builder, loc, mutableBox);
         caller.placeInput(arg, irBox);
         if (arg.mayBeModifiedByCall())
           mutableModifiedByCall.emplace_back(std::move(mutableBox));
+        if (fir::isAllocatableType(argTy) && arg.isIntentOut() &&
+            Fortran::semantics::IsBindCProcedure(*procRef.proc().GetSymbol()))
+          Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
         continue;
       }
       if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar ||
           arg.passBy == PassBy::BaseAddressValueAttribute ||
           arg.passBy == PassBy::CharBoxValueAttribute) {
         const bool byValue = arg.passBy == PassBy::BaseAddressValueAttribute ||
                              arg.passBy == PassBy::CharBoxValueAttribute;
         ExtValue argAddr =

flang/lib/Lower/ConvertVariable.cpp

builder.genIfThen(loc, isPresent)
         })
         .end();
   } else {
     mlir::Value box = builder.createBox(loc, exv);
     fir::runtime::genDerivedTypeInitialize(builder, loc, box);
   }
 }
 
+// Fortran 2018 - 9.7.3.2 point 6
+// When a procedure is invoked, any allocated allocatable object that is an
+// actual argument corresponding to an INTENT(OUT) allocatable dummy argument
+// is deallocated; any allocated allocatable object that is a subobject of an
+// actual argument corresponding to an INTENT(OUT) dummy argument is
+// deallocated.
+static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
+                                const Fortran::lower::pft::Variable &var,
+                                Fortran::lower::SymMap &symMap) {
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  if (Fortran::semantics::IsDummy(sym) &&
+      Fortran::semantics::IsIntentOut(sym) &&
+      Fortran::semantics::IsAllocatable(sym)) {
+    if (auto symbox = symMap.lookupSymbol(sym)) {
+      fir::ExtendedValue extVal = symbox.toExtendedValue();
+      if (auto mutBox = extVal.getBoxOf<fir::MutableBoxValue>()) {
+        mlir::Location loc = converter.getCurrentLocation();
+        if (Fortran::semantics::IsOptional(sym)) {
+          fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+          auto isPresent = builder.create<fir::IsPresentOp>(
+              loc, builder.getI1Type(), fir::getBase(extVal));
+          builder.genIfThen(loc, isPresent)
+              .genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
+              .end();
+        } else {
+          genDeallocateBox(converter, *mutBox, loc);
+        }
+      }
+    }
+  }
+}
+
 /// Instantiate a local variable. Precondition: Each variable will be visited
 /// such that if its properties depend on other variables, the variables upon
 /// which its properties depend will already have been visited.
 static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
                              const Fortran::lower::pft::Variable &var,
                              Fortran::lower::SymMap &symMap) {
   assert(!var.isAlias());
   Fortran::lower::StatementContext stmtCtx;
   mapSymbolAttributes(converter, var, symMap, stmtCtx);
+  deallocateIntentOut(converter, var, symMap);
   if (mustBeDefaultInitializedAtRuntime(var))
     defaultInitializeAtRuntime(converter, var, symMap);
 }
 
 //===----------------------------------------------------------------===//
 // Aliased (EQUIVALENCE) variables instantiation
 //===----------------------------------------------------------------===//
 

flang/test/Lower/intentout-deallocate.f90

+! Test correct deallocation of intent(out) allocatables.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module mod1
+  type, bind(c) :: t1
+    integer :: i
+  end type
+
+  interface
+    subroutine sub3(a) bind(c)
+      integer, intent(out), allocatable :: a(:)
+    end subroutine
+  end interface
+
+  interface
+    subroutine sub7(t) bind(c)
+      import :: t1
+      type(t1), allocatable, intent(out) :: t
+    end subroutine
+  end interface
+
+contains
+  subroutine sub0()
+    integer, allocatable :: a(:)
+    allocate(a(10))
+    call sub1(a)
+  end subroutine
+
+  subroutine sub1(a)
+    integer, intent(out), allocatable :: a(:)
+  end subroutine
+
+! Make sure there is no deallocation of the allocatable intent(out) on the
+! caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub0()
+! CHECK-NOT: fir.freemem
+! CHECK: fir.call @_QMmod1Psub1
+
+! Check inline deallocation of allocatable intent(out) on the callee side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub1(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a"})
+! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.freemem %[[BOX_ADDR]] : !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+
+  subroutine sub2()
+    integer, allocatable :: a(:)
+    allocate(a(10))
+    call sub3(a)
+  end subroutine
+
+! Check inlined deallocation of allocatble intent(out) on the caller side for BIND(C).
+
+! CHECK-LABEL: func.func @_QMmod1Psub2()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "a", uniq_name = "_QMmod1Fsub2Ea"}
+! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QMmod1Fsub2Ea.addr"}
+! CHECK: %[[LOAD:.*]] = fir.load %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %{{.*}} = fir.embox %[[LOAD]](%{{.*}}) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<
+! CHECK: %[[LOAD:.*]] = fir.load %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.freemem %[[LOAD]] : !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[ZERO]] to %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.call @sub3(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> ()
+
+  subroutine sub4()
+    type(t1), allocatable :: t
+    call sub5(t)
+  end subroutine
+
+  subroutine sub5(t)
+    type(t1), allocatable, intent(out) :: t
+  end subroutine
+
+! Make sure there is no deallocation runtime call of the allocatable intent(out)
+! on the caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub4()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>> {bindc_name = "t", uniq_name = "_QMmod1Fsub4Et"}
+! CHECK-NOT: fir.call @_FortranAAllocatableDeallocate
+! CHECK: fir.call @_QMmod1Psub5(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> ()
+
+! Check deallocation of allocatble intent(out) on the callee side. Deallocation
+! is done with a runtime call.
+
+! CHECK-LABEL: func.func @_QMmod1Psub5(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>> {fir.bindc_name = "t"})
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+  subroutine sub6()
+    type(t1), allocatable :: t
+    call sub7(t)
+  end subroutine
+
+! Check deallocation of allocatble intent(out) on the caller side for BIND(C).
+! Deallocation is done with a runtime call.
+
+! CHECK-LABEL: func.func @_QMmod1Psub6()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>> {bindc_name = "t", uniq_name = "_QMmod1Fsub6Et"}
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: fir.call @sub7(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> ()
+
+  subroutine sub8()
+    integer, allocatable :: a(:)
+    allocate(a(10))
+    call sub9(a)
+  end subroutine
+
+  subroutine sub9(a)
+    integer, intent(out), allocatable, optional :: a(:)
+  end subroutine
+
+! Make sure there is no deallocation of the allocatable intent(out) on the
+! caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub8()
+! CHECK-NOT: fir.freemem
+! CHECK: fir.call @_QMmod1Psub9
+
+! Check inline deallocation of optional allocatable intent(out) on the callee side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub9(
+! CHECK-SAME:  %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a", fir.optional})
+! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> i1
+! CHECK: fir.if %[[IS_PRESENT]] {
+! CHECK:   %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK:   %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK:   fir.freemem %[[BOX_ADDR]] : !fir.heap<!fir.array<?xi32>>
+! CHECK:   %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK:   %[[C0:.*]] = arith.constant 0 : index
+! CHECK:   %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+! CHECK:   %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK:   fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: }
+
+end module
+