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

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

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D145679

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 9a19e42..69b07a1 100644 (file)
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -726,11 +726,26 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
           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() ||
@@ -738,20 +753,7 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
           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);

diff --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90
index f48b202..936d8a4 100644 (file)
--- a/flang/test/Lower/intentout-deallocate.f90
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -238,5 +238,19 @@ contains
 ! 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