[flang] Handle polymorphic entities with rank > 0 in entry statement

[clementval]

Summary

Correctly create the temporary for argument absent in the entry statement.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/MutableBox.h

 
 /// Create a MutableBoxValue for a temporary allocatable.
 /// The created MutableBoxValue wraps a fir.ref<fir.box<fir.heap<type>>> and is
 /// initialized to unallocated/diassociated status. An optional name can be
 /// given to the created !fir.ref<fir.box>.
 fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder,
                                           mlir::Location loc, mlir::Type type,
                                           llvm::StringRef name = {},
-                                          mlir::Value sourceBox = {});
+                                          mlir::Value sourceBox = {},
+                                          bool isPolymorphic = false);
 
 /// Update a MutableBoxValue to describe entity \p source (that must be in
 /// memory). If \lbounds is not empty, it is used to defined the MutableBoxValue
 /// lower bounds, otherwise, the lower bounds from \p source are used.
 void associateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::MutableBoxValue &box,
                          const fir::ExtendedValue &source,
                          mlir::ValueRange lbounds);

flang/lib/Lower/ConvertVariable.cpp

void Fortran::lower::mapSymbolAttributes(
   //    for dynamic objects via calls to genUnusedEntryPointBox.
 
   auto genUnusedEntryPointBox = [&]() {
     if (isUnusedEntryDummy) {
       assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
              "handled above");
       // The box is read right away because lowering code does not expect
       // a non pointer/allocatable symbol to be mapped to a MutableBox.
+      mlir::Type ty = converter.genType(var);
+      bool isPolymorphic = false;
+      if (auto boxTy = ty.dyn_cast<fir::BaseBoxType>()) {
+        isPolymorphic = ty.isa<fir::ClassType>();
+        ty = boxTy.getEleTy();
+      }
       Fortran::lower::genDeclareSymbol(
           converter, symMap, sym,
           fir::factory::genMutableBoxRead(
               builder, loc,
-              fir::factory::createTempMutableBox(builder, loc,
-                                                 converter.genType(var))));
+              fir::factory::createTempMutableBox(builder, loc, ty, {}, {},
+                                                 isPolymorphic)));
       return true;
     }
     return false;
   };
 
   // Helper to generate scalars for the symbol properties.
   auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
     return genScalarValue(converter, loc, expr, symMap, stmtCtx);

flang/lib/Optimizer/Builder/MutableBox.cpp

mlir::Value fir::factory::createUnallocatedBox(
   }
   mlir::Value emptySlice;
   return builder.create<fir::EmboxOp>(loc, boxType, nullAddr, shape, emptySlice,
                                       lenParams, typeSourceBox);
 }
 
 fir::MutableBoxValue fir::factory::createTempMutableBox(
     fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type,
-    llvm::StringRef name, mlir::Value typeSourceBox) {
+    llvm::StringRef name, mlir::Value typeSourceBox, bool isPolymorphic) {
   mlir::Type boxType;
-  if (typeSourceBox)
+  if (typeSourceBox || isPolymorphic)
     boxType = fir::ClassType::get(fir::HeapType::get(type));
   else
     boxType = fir::BoxType::get(fir::HeapType::get(type));
   auto boxAddr = builder.createTemporary(loc, boxType, name);
   auto box =
       fir::MutableBoxValue(boxAddr, /*nonDeferredParams=*/mlir::ValueRange(),
                            /*mutableProperties=*/{});
   MutablePropertyWriter{builder, loc, box, typeSourceBox}

flang/test/Lower/polymorphic.f90

 ! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_with_entry(
 ! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
 ! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "b", uniq_name = "_QMpolymorphic_testFclass_with_entryEb"}
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPd(
 ! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "b"}) {
 ! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFclass_with_entryEa"}
 
+  subroutine class_array_with_entry(a)
+    class(p1) :: a(:), b(:)
+    select type (a)
+    type is(p2)
+      print*, a%c
+    class default
+      print*, a%a
+    end select
+    return
+  entry g(b)
+    select type(b)
+    type is(p2)
+      print*,b%c
+    class default
+      print*,b%a
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_array_with_entry(
+! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPg(
+! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "b"}) {
+! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+
 end module
 
 program test
   use polymorphic_test
   type(outer), allocatable :: o
   integer :: i(5)
   logical :: l(5)
   allocate(o)