[flang] Deallocate polymorphic and unlimited polymorphic intent(out) allocatable with runtime

[clementval]

Summary

Polymorphic and unlimited polymorphic entities should be handled by runtime. This patch
update the condition in genDeallocate to force polymorphic and unlimited polymorphic entities
to be deallocated through a runtime call and not inlined.

Depends on D135143

[jeanPerier]

flang/lib/Lower/Allocatable.cpp

514–516

Why doing this for unlimited polymorphic only ? Isn't the runtime needed with polymorphic in general to find the right finialization routine ?

[clementval]

flang/lib/Lower/Allocatable.cpp

514–516

Yes, polymorphic also need to go through the runtime. They are actually already covered by the first condition since they are "box" with derived type (test polymorphic_allocatable_intentout is checking for that). To be sure and make the code more readable I'll update the condition to a !box.isPolymorphic() so it covers both polymorphic and unlimited polymorphic

[jeanPerier]

flang/lib/Lower/Allocatable.cpp

514–516

Doh, makes sense. You can also keep isUnlimitedPolymorphic then, as you prefer.

[clementval]

Add condition for polymoprhic to make things clearer.

[PeteSteinfeld]

Doesn't build.

flang/include/flang/Optimizer/Builder/BoxValue.h

254

It looks like you misspelled isPolymorphic.

[clementval]

Fix typo

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/BoxValue.h

public:
 
   /// Is this a derived type entity ?
   bool isDerived() const { return getEleTy().isa<fir::RecordType>(); }
 
   bool isDerivedWithLenParameters() const {
     return fir::isRecordWithTypeParameters(getEleTy());
   }
 
-  /// Is this a CLASS(*)/TYPE(*) ?
+  /// Is this a polymorphic entity?
+  bool isPolymorphic() const { return fir::isPolymorphicType(getBoxTy()); }
+
+  /// Is this a CLASS(*)/TYPE(*)?
   bool isUnlimitedPolymorphic() const {
-    return fir::isUnlimitedPolymorphicType(getBaseTy());
+    return fir::isUnlimitedPolymorphicType(getBoxTy());
   }
 };
 
 /// An entity described by a fir.box value that cannot be read into
 /// another ExtendedValue category, either because the fir.box may be an
 /// absent optional and we need to wait until the user is referencing it
 /// to read it, or because it contains important information that cannot
 /// be exposed in FIR (e.g. non contiguous byte stride).

flang/lib/Lower/Allocatable.cpp

 // Deallocate statement implementation
 //===----------------------------------------------------------------------===//
 
 // Generate deallocation of a pointer/allocatable.
 static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
                           const fir::MutableBoxValue &box,
                           ErrorManager &errorManager) {
   // Deallocate intrinsic types inline.
-  if (!box.isDerived() && !errorManager.hasStatSpec() && !useAllocateRuntime) {
+  if (!box.isDerived() && !box.isPolymorphic() &&
+      !box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() &&
+      !useAllocateRuntime) {
     fir::factory::genInlinedDeallocate(builder, loc, box);
     return;
   }
   // Use runtime calls to deallocate descriptor cases. Sync MutableBoxValue
   // with its descriptor before and after calls if needed.
   errorManager.genStatCheck(builder, loc);
   mlir::Value stat = genRuntimeDeallocate(builder, loc, box, errorManager);
   fir::factory::syncMutableBoxFromIRBox(builder, loc, box);

flang/test/Lower/polymorphic-types.f90

! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.heap<none>>>
 
   subroutine unlimited_polymorphic_pointer(p)
     class(*), pointer :: p
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_pointer(
 ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.ptr<none>>>
 
+  subroutine unlimited_polymorphic_allocatable_intentout(p)
+    class(*), allocatable, intent(out) :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_allocatable_intentout(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
 ! ------------------------------------------------------------------------------
 ! Test polymorphic function return types
 ! ------------------------------------------------------------------------------
 
   function ret_polymorphic_allocatable() result(ret)
     class(p1), allocatable :: ret
   end function