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

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-09T17:48:34+01:00
New Revision: 8d394367d39fddeeb56a43d64f0df209162b330a

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

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

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

Depends on D145679

Reviewed By: PeteSteinfeld

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

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 69b07a191669..b5470e5210fc 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -727,15 +727,26 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
       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);
+        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);
+                }
+              })
+              .end();
         } else {
           genDeallocateBox(converter, *mutBox, loc);
         }
@@ -748,16 +759,7 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
             .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();
       }
     }
   }

diff  --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90
index 936d8a434c1b..d27d7e2e7a96 100644
--- a/flang/test/Lower/intentout-deallocate.f90
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -246,10 +246,17 @@ subroutine sub16(p)
 ! 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:   %[[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