[flang] Check if dummy is allocated before deallocation for optional intent(out)

[clementval]

Summary

Similary to non-optional argument, check if the argument is allocated before
doing the deallocation for intent(out) optional.

Depends on D145679

[PeteSteinfeld]

@clementval, I wasn't able to download this patch because arc patch could not resolve the dependencies. Could you please rebase after delivering D145679?

[clementval]

Rebase

[PeteSteinfeld]

Things build and test correctly, but .../llvm-project/flang/lib/Lower/ConvertVariable.cpp needs to have clang-format run on it. Please do so before merging.

[clementval]

clang-format

flang/lib/Lower/ConvertVariable.cpp

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();
       fir::FirOpBuilder &builder = converter.getFirOpBuilder();
       auto genDeallocateWithTypeDesc = [&]() {
+        if (mutBox->isDerived() || mutBox->isPolymorphic() ||
+            mutBox->isUnlimitedPolymorphic()) {
+          mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
+              builder, loc, *mutBox);
+          builder.genIfThen(loc, isAlloc)
+              .genThen([&]() {
                 if (mutBox->isPolymorphic()) {
                   mlir::Value declaredTypeDesc;
                   assert(sym.GetType());
-          if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
-                  sym.GetType()->AsDerived()) {
+                  if (const Fortran::semantics::DerivedTypeSpec
+                          *derivedTypeSpec = sym.GetType()->AsDerived()) {
                     declaredTypeDesc = Fortran::lower::getTypeDescAddr(
                         converter, loc, *derivedTypeSpec);
                   }
                   genDeallocateBox(converter, *mutBox, loc, declaredTypeDesc);
                 } else {
                   genDeallocateBox(converter, *mutBox, loc);
                 }
+              })
+              .end();
+        } else {
+          genDeallocateBox(converter, *mutBox, loc);
+        }
       };
 
       if (Fortran::semantics::IsOptional(sym)) {
         auto isPresent = builder.create<fir::IsPresentOp>(
             loc, builder.getI1Type(), fir::getBase(extVal));
         builder.genIfThen(loc, isPresent)
             .genThen([&]() { genDeallocateWithTypeDesc(); })
             .end();
       } else {
-        if (mutBox->isDerived() || mutBox->isPolymorphic() ||
-            mutBox->isUnlimitedPolymorphic()) {
-          mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
-              builder, loc, *mutBox);
-          builder.genIfThen(loc, isAlloc)
-              .genThen([&]() { genDeallocateWithTypeDesc(); })
-              .end();
-        } else {
-          genDeallocateBox(converter, *mutBox, loc);
-        }
+        genDeallocateWithTypeDesc();
       }
     }
   }
 }
 
 /// 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.

flang/test/Lower/intentout-deallocate.f90

! CHECK: }
   subroutine sub16(p)
     class(t), optional, intent(out), allocatable :: p
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMmod1Psub16(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>> {fir.bindc_name = "p", fir.optional}) {
 ! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> i1
 ! CHECK: fir.if %[[IS_PRESENT]] {
-! CHECK:   %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMmod1Tt{a:i32}>
-! CHECK:   %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK:   %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMmod1Tt{a:i32}>>) -> !fir.ref<none> 
-! CHECK:   %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK: }
+! CHECK:   %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>
+! CHECK:   %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>) -> !fir.heap<!fir.type<_QMmod1Tt{a:i32}>>
+! CHECK:   %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>) -> i64
+! CHECK:   %[[C0:.*]] = arith.constant 0 : i64
+! CHECK:   %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
+! CHECK:   fir.if %[[IS_ALLOCATED]] {
+! CHECK:     %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMmod1Tt{a:i32}>
+! CHECK:     %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK:     %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMmod1Tt{a:i32}>>) -> !fir.ref<none> 
+! CHECK:     %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:   }
+! CHECK: }
 
 end module