[flang] Reset dynamic type for optional intent(out) allocatable polymorphic dummy

[clementval]

Summary

Allocatable intent(out) are deallocated at the beginning of a function/subroutine.
For polyrmophic entities, the dynamic type need to be reseted to the declared
type. This patch makes sure this is done when the dummy argument is optional and
present.

Depends on D145674

[clementval]

Remove debug code

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/ConvertVariable.cpp

if (Fortran::semantics::IsDummy(sym) &&
     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->isPolymorphic()) {
+          mlir::Value declaredTypeDesc;
+          assert(sym.GetType());
+          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);
+        }
+      };
+
       if (Fortran::semantics::IsOptional(sym)) {
         auto isPresent = builder.create<fir::IsPresentOp>(
             loc, builder.getI1Type(), fir::getBase(extVal));
         builder.genIfThen(loc, isPresent)
-            .genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
+            .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([&]() {
-                if (mutBox->isPolymorphic()) {
-                  mlir::Value declaredTypeDesc;
-                  assert(sym.GetType());
-                  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);
-                }
-              })
+              .genThen([&]() { genDeallocateWithTypeDesc(); })
               .end();
         } else {
           genDeallocateBox(converter, *mutBox, loc);
         }
       }
     }
   }
 }

flang/test/Lower/intentout-deallocate.f90

 ! CHECK: %[[C0:.*]] = arith.constant 0 : i64
 ! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
 ! CHECK: fir.if %[[IS_ALLOCATED]] {
 ! CHECK:   %[[NULL_TYPE_DESC:.*]] = fir.zero_bits !fir.ref<none>  
 ! CHECK:   %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK:   %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %[[NULL_TYPE_DESC]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
 ! 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: }
+
 end module