[flang] Avoid deallocation of intent(out) when dummy arg is not in entry stmt

[clementval]

Summary

In some case, the ENTRY statement in a procedure is including some
dummy argument. Until now, deallocation of intent(out) allocatable was
not checking for this and it could result in a segmentation fault.

This patch avoids deallocation when the value is not in the ENTRY stmt.

[jeanPerier]

LGTM (assuming the next build succeeds).

[clementval]

Rebase to trigger a fresh build

[PeteSteinfeld]

Other than the clang-format problem, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertVariable.cpp

627

I get a diff when I run clang-format on this line. Here's what I think it should be:

if (mlir::Operation *op = mutBox->getAddr().getDefiningOp())

[clementval]

clang-format

[clementval]

flang/lib/Lower/ConvertVariable.cpp

627

Yeah you are right. My clang-format was a bit out of date.

[clementval]

In D134342#3805595, @jeanPerier wrote:

LGTM (assuming the next build succeeds).

Thanks. Looks like pre commit checks are down for the moment.

flang/lib/Lower/ConvertVariable.cpp

 // 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) {
+  if (!var.hasSymbol())
+    return;
+
   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>()) {
+        // The dummy argument is not passed in the ENTRY so it should not be
+        // deallocated.
+        if (mlir::Operation *op = mutBox->getAddr().getDefiningOp())
+          if (mlir::isa<fir::AllocaOp>(op))
+            return;
         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();

flang/test/Lower/intentout-deallocate.f90

 ! 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: }
 
+  subroutine sub10(a)
+    integer, intent(out), allocatable :: a(:)
+
+  entry sub11
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMmod1Psub10(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD]] : (!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-LABEL: func.func @_QMmod1Psub11() {
+! CHECK-NOT: fir.freemem
+
+  subroutine sub12(a)
+    integer, intent(out), allocatable :: a(:)
+  entry sub13(a)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMmod1Psub12(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD]] : (!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-LABEL: func.func @_QMmod1Psub13(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD]] : (!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>>>>
+
+
 end module