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

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-09T15:48:44+01:00
New Revision: dd8a2434c7f200d54f167166b4db2e3057676f5e

URL: https://github.com/llvm/llvm-project/commit/dd8a2434c7f200d54f167166b4db2e3057676f5e
DIFF: https://github.com/llvm/llvm-project/commit/dd8a2434c7f200d54f167166b4db2e3057676f5e.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Lower/ConvertVariable.cpp
    flang/test/Lower/intentout-deallocate.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 9a19e422ba45..69b07a191669 100644
--- 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 f48b20210210..936d8a434c1b 100644
--- a/flang/test/Lower/intentout-deallocate.f90
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -236,6 +236,20 @@ subroutine sub15(p)
 ! 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