[flang] Lower and code gen for allocate on polymorphic entities

[clementval]

Summary

When allocating a polymorphic entity, its type descriptor can come
from the declared type or can be provided in the allocate statement.
This patch adds lowering for allocate on polymorphic by calling
the AllocatableInitDerived runtime function with the correct
type descriptor. Some adaptation are made in the code generation
to accept fir.class where it is appropriate.

[clementval]

Remove unrelated change

[clementval]

Update design doc as well

[jeanPerier]

LGTM

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

308

Wow, you made that type accurate ! I am pondering whether this is needed or not. Do you see drawbacks of using fir.ref<None> for this type currently ?
The cons I see of defining the accurate type here is that you will have to maintain it if it changes, and it makes the IR a bit more verbose (although I really think we should leverage MLIR type aliasing to make IR with derived type more readable, so it should not be the main motivation).

flang/lib/Lower/Allocatable.cpp

492

I think this assert should be a fir::emitFatalError() instead because a user can trigger this state by hiding the intrinsic module which will prevent type descriptor symbols to not be created and generated.

[clementval]

Address review comments

[clementval]

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

308

Yeah it's a bit overkill here. Going with the !fir.ref<none> at least for now since there is no real need to have the accruate type.

flang/lib/Lower/Allocatable.cpp

492

Changed to fatal error.

flang/docs/PolymorphicEntities.md

 **Fortran**
 ```fortran
 allocate(triangle::shapes(1)%item)
 allocate(rectangle::shapes(2)%item)
 ```
 
 **FIR**
 ```c
-%0 = fir.alloca !fir.class<!fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32>>
-%1 = fir.alloca !fir.class<!fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32}>>
-%3 = fir.convert %0 : (!fir.ref<!fir.class<!fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32>>>) -> !fir.ref<!fir.box<none>>
-%4 = fir.gentypedesc !fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32}>>
-%5 = fir.call @_FortranAAllocatableInitDerived(%3, %4)
-
-%6 = fir.convert %1 : (!fir.ref<!fir.class<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32}>>>) -> !fir.ref<!fir.box<none>>
-%7 = fir.gentypedesc !fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32}>> %8 = fir.call @_FortranAAllocatableInitDerived(%6, %7)
+%0 = fir.address_of(@_QMgeometryE.dt.triangle) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype>>
+%1 = fir.convert %item1 : (!fir.ref<!fir.class<!fir.type<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32>>>) -> !fir.ref<!fir.box<none>>
+%2 = fir.call @_FortranAAllocatableInitDerived(%1, %0)
+%3 = fir.call @_FortranAAllocatableAllocate(%1, ...)
+
+%4 = fir.address_of(@_QMgeometryE.dt.rectangle) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype>>
+%5 = fir.convert %item2 : (!fir.ref<!fir.class<_QMgeometryTtriangle{color:i32,isFilled:!fir.logical<4>,base:f32,height:f32}>>>) -> !fir.ref<!fir.box<none>>
+%6 = fir.call @_FortranAAllocatableInitDerived(%5, %4)
+%7 = fir.call @_FortranAAllocatableAllocate(%5, ...)
 ```
 
 For pointer allocation, the `PointerAllocate` function is used.
 
 `DEALLOCATE`
 
 The `DEALLOCATE` statement is lowered to a runtime call to
 `AllocatableDeallocate` and `PointerDeallocate` for pointers.
- Polymorphic entities involved a lot of runtime information so executable
   tests will be useful for full testing.
 
 ---
 
 # Current TODOs
 Current list of TODOs in lowering:
 - `flang/lib/Lower/Allocatable.cpp:465` not yet implemented: SOURCE allocation
 - `flang/lib/Lower/Allocatable.cpp:468` not yet implemented: MOLD allocation
-- `flang/lib/Lower/Allocatable.cpp:471` not yet implemented: polymorphic entity allocation
 - `flang/lib/Lower/Bridge.cpp:448` not yet implemented: create polymorphic host associated copy
 - `flang/lib/Lower/Bridge.cpp:2185` not yet implemented: assignment to polymorphic allocatable
 - `flang/lib/Lower/Bridge.cpp:2288` not yet implemented: pointer assignment involving polymorphic entity
 - `flang/lib/Lower/Bridge.cpp:2316` not yet implemented: pointer assignment involving polymorphic entity
 - `flang/lib/Lower/CallInterface.cpp:795` not yet implemented: support for polymorphic types
 - `flang/lib/Lower/ConvertType.cpp:237` not yet implemented: support for polymorphic types
 
 Current list of TODOs in code generation:

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

 // and std::complex are layout compatible, but not compatible in all ABI call
 // interfaces (e.g. X86 32 bits). _Complex is not standard C++, so do not use
 // it here.
 struct c_float_complex_t;
 struct c_double_complex_t;
 
 namespace Fortran::runtime {
 class Descriptor;
+namespace typeInfo {
+class DerivedType;
 }
+} // namespace Fortran::runtime
 
 namespace fir::runtime {
 
 using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *);
 using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *);
 
 //===----------------------------------------------------------------------===//
 // Type builder models

 template <>
 constexpr TypeBuilderFunc getModel<Fortran::common::TypeCategory>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::IntegerType::get(context,
                                   sizeof(Fortran::common::TypeCategory) * 8);
   };
 }
 template <>
+constexpr TypeBuilderFunc
+getModel<const Fortran::runtime::typeInfo::DerivedType &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::NoneType::get(context));
+  };
+}
+template <>
 constexpr TypeBuilderFunc getModel<void>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
     return mlir::NoneType::get(context);
   };
 }
 
 template <typename...>
 struct RuntimeTableKey;
 template <typename RT, typename... ATs>
 struct RuntimeTableKey<RT(ATs...)> {
   static constexpr FuncTypeBuilderFunc getTypeModel() {
     return [](mlir::MLIRContext *ctxt) {
       TypeBuilderFunc ret = getModel<RT>();
       std::array<TypeBuilderFunc, sizeof...(ATs)> args = {getModel<ATs>()...};
       mlir::Type retTy = ret(ctxt);
       llvm::SmallVector<mlir::Type, sizeof...(ATs)> argTys;
       for (auto f : args)
         argTys.push_back(f(ctxt));
       return mlir::FunctionType::get(ctxt, argTys, {retTy});
     };
   }
 };
 
 //===----------------------------------------------------------------------===//

flang/lib/Lower/Allocatable.cpp

 //===-- Allocatable.cpp -- Allocatable statements lowering ----------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Allocatable.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/IterationSpace.h"
+#include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
+#include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Runtime/allocatable.h"
 #include "flang/Runtime/pointer.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "llvm/Support/CommandLine.h"
 
 /// By default fir memory operation fir::AllocMemOp/fir::FreeMemOp are used.
if (box.isPointer()) {
       assert(box.isAllocatable() && "must be an allocatable");
       // For allocatables, sync the MutableBoxValue and descriptor before the
       // calls in case it is tracked locally by a set of variables.
       fir::factory::getMutableIRBox(builder, loc, box);
     }
     if (alloc.hasCoarraySpec())
       TODO(loc, "coarray allocation");
     if (alloc.type.IsPolymorphic())
-      genSetType(alloc, box);
+      genSetType(alloc, box, loc);
     genSetDeferredLengthParameters(alloc, box);
     // Set bounds for arrays
     mlir::Type idxTy = builder.getIndexType();
     mlir::Type i32Ty = builder.getIntegerType(32);
     Fortran::lower::StatementContext stmtCtx;
     for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
       mlir::Value lb;
       const auto &bounds = iter.value().t;
private:
   }
 
   void genSourceAllocation(const Allocation &, const fir::MutableBoxValue &) {
     TODO(loc, "SOURCE allocation");
   }
   void genMoldAllocation(const Allocation &, const fir::MutableBoxValue &) {
     TODO(loc, "MOLD allocation");
   }
-  void genSetType(const Allocation &, const fir::MutableBoxValue &) {
-    TODO(loc, "polymorphic entity allocation");
+
+  /// Generate call to the AllocatableInitDerived to set up the type descriptor
+  /// and other part of the descriptor for derived type.
+  void genSetType(const Allocation &alloc, const fir::MutableBoxValue &box,
+                  mlir::Location loc) {
+    const Fortran::semantics::DeclTypeSpec *typeSpec =
+        getIfAllocateStmtTypeSpec();
+
+    // No type spec provided in allocate statement so the declared type spec is
+    // used.
+    if (!typeSpec)
+      typeSpec = &alloc.type;
+
+    assert(typeSpec && "type spec missing for polymorphic allocation");
+    std::string typeName =
+        Fortran::lower::mangle::mangleName(typeSpec->derivedTypeSpec());
+    std::string typeDescName =
+        fir::NameUniquer::getTypeDescriptorName(typeName);
+
+    auto typeDescGlobal =
+        builder.getModule().lookupSymbol<fir::GlobalOp>(typeDescName);
+    if (!typeDescGlobal)
+      fir::emitFatalError(loc, "type descriptor not defined");
+    auto typeDescAddr = builder.create<fir::AddrOfOp>(
+        loc, fir::ReferenceType::get(typeDescGlobal.getType()),
+        typeDescGlobal.getSymbol());
+    mlir::func::FuncOp callee =
+        fir::runtime::getRuntimeFunc<mkRTKey(AllocatableInitDerived)>(loc,
+                                                                      builder);
+
+    llvm::ArrayRef<mlir::Type> inputTypes =
+        callee.getFunctionType().getInputs();
+    llvm::SmallVector<mlir::Value> args;
+    args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
+    args.push_back(builder.createConvert(loc, inputTypes[1], typeDescAddr));
+    mlir::Value rank = builder.createIntegerConstant(loc, inputTypes[2],
+                                                     alloc.getSymbol().Rank());
+    mlir::Value c0 = builder.createIntegerConstant(loc, inputTypes[3], 0);
+    args.push_back(rank);
+    args.push_back(c0);
+    builder.create<fir::CallOp>(loc, callee, args);
   }
 
   /// Returns a pointer to the DeclTypeSpec if a type-spec is provided in the
   /// allocate statement. Returns a null pointer otherwise.
   const Fortran::semantics::DeclTypeSpec *getIfAllocateStmtTypeSpec() const {
     if (const auto &typeSpec =
             std::get<std::optional<Fortran::parser::TypeSpec>>(stmt.t))
       return typeSpec->declTypeSpec;

flang/lib/Optimizer/CodeGen/CodeGen.cpp

 /// if they are applied on the full range.
 struct GlobalOpConversion : public FIROpConversion<fir::GlobalOp> {
   using FIROpConversion::FIROpConversion;
 
   mlir::LogicalResult
   matchAndRewrite(fir::GlobalOp global, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
     auto tyAttr = convertType(global.getType());
-    if (global.getType().isa<fir::BoxType>())
+    if (global.getType().isa<fir::BaseBoxType>())
       tyAttr = tyAttr.cast<mlir::LLVM::LLVMPointerType>().getElementType();
     auto loc = global.getLoc();
     mlir::Attribute initAttr = global.getInitVal().value_or(mlir::Attribute());
     auto linkage = convertLinkage(global.getLinkName());
     auto isConst = global.getConstant().has_value();
     auto g = rewriter.create<mlir::LLVM::GlobalOp>(
         loc, tyAttr, isConst, linkage, global.getSymName(), initAttr);
     auto &gr = g.getInitializerRegion();

flang/lib/Optimizer/CodeGen/TypeConverter.h

addConversion([&](fir::VectorType vecTy) {
                                    convertType(vecTy.getEleTy()));
     });
     addConversion([&](mlir::TupleType tuple) {
       LLVM_DEBUG(llvm::dbgs() << "type convert: " << tuple << '\n');
       llvm::SmallVector<mlir::Type> members;
       for (auto mem : tuple.getTypes()) {
         // Prevent fir.box from degenerating to a pointer to a descriptor in the
         // context of a tuple type.
-        if (auto box = mem.dyn_cast<fir::BoxType>())
+        if (auto box = mem.dyn_cast<fir::BaseBoxType>())
           members.push_back(convertBoxTypeAsStruct(box));
         else
           members.push_back(convertType(mem).cast<mlir::Type>());
       }
       return mlir::LLVM::LLVMStructType::getLiteral(&getContext(), members,
                                                     /*isPacked=*/false);
     });
     addConversion([&](mlir::NoneType none) {
convertRecordType(fir::RecordType derived,
     if (llvm::count(callStack, derived) > 1) {
       results.push_back(st);
       return mlir::success();
     }
     llvm::SmallVector<mlir::Type> members;
     for (auto mem : derived.getTypeList()) {
       // Prevent fir.box from degenerating to a pointer to a descriptor in the
       // context of a record type.
-      if (auto box = mem.second.dyn_cast<fir::BoxType>())
+      if (auto box = mem.second.dyn_cast<fir::BaseBoxType>())
         members.push_back(convertBoxTypeAsStruct(box));
       else
         members.push_back(convertType(mem.second).cast<mlir::Type>());
     }
     if (mlir::failed(st.setBody(members, /*isPacked=*/false)))
       return mlir::failure();
     results.push_back(st);
     return mlir::success();
mlir::Type convertBoxType(BaseBoxType box, int rank = unknownRank()) {
     }
     return mlir::LLVM::LLVMPointerType::get(
         mlir::LLVM::LLVMStructType::getLiteral(&getContext(), dataDescFields,
                                                /*isPacked=*/false));
   }
 
   /// Convert fir.box type to the corresponding llvm struct type instead of a
   /// pointer to this struct type.
-  mlir::Type convertBoxTypeAsStruct(BoxType box) {
+  mlir::Type convertBoxTypeAsStruct(BaseBoxType box) {
     return convertBoxType(box)
         .cast<mlir::LLVM::LLVMPointerType>()
         .getElementType();
   }
 
   // fir.boxproc<any>  -->  llvm<"{ any*, i8* }">
   mlir::Type convertBoxProcType(BoxProcType boxproc) {
     auto funcTy = convertType(boxproc.getEleTy());
if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>()) {
       }
     }
     // fir.ref<fir.box> is a special case because fir.box type is already
     // a pointer to a Fortran descriptor at the LLVM IR level. This implies
     // that a fir.ref<fir.box>, that is the address of fir.box is actually
     // the same as a fir.box at the LLVM level.
     // The distinction is kept in fir to denote when a descriptor is expected
     // to be mutable (fir.ref<fir.box>) and when it is not (fir.box).
-    if (eleTy.isa<fir::BoxType>())
+    if (eleTy.isa<fir::BaseBoxType>())
       return convertType(eleTy);
 
     return mlir::LLVM::LLVMPointerType::get(convertType(eleTy));
   }
 
   // convert a front-end kind value to either a std or LLVM IR dialect type
   // fir.real<n>  -->  llvm.anyfloat  where anyfloat is a kind mapping
   mlir::Type convertRealType(fir::KindTy kind) {

flang/test/Lower/allocatable-polymorphic.f90

+! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -polymorphic-type -emit-fir %s -o - | tco | FileCheck %s --check-prefix=LLVM
+
+module poly
+  type p1
+    integer :: a
+    integer :: b
+  end type
+
+  type, extends(p1) :: p2
+    integer :: c
+  end type
+end module
+
+program test_allocatable
+  use poly
+
+  class(p1), allocatable :: p
+  class(p1), allocatable :: c1, c2
+  class(p1), allocatable, dimension(:) :: c3, c4
+
+  allocate(p) ! allocate as p1
+
+  allocate(p1::c1)
+  allocate(p2::c2)
+
+  allocate(p1::c3(10))
+  allocate(p2::c4(20))
+
+end
+
+! CHECK-LABEL: func.func @_QQmain()
+
+! CHECK-DAG: %[[C1:.*]] = fir.address_of(@_QFEc1) : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>
+! CHECK-DAG: %[[C2:.*]] = fir.address_of(@_QFEc2) : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>
+! CHECK-DAG: %[[C3:.*]] = fir.address_of(@_QFEc3) : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>
+! CHECK-DAG: %[[C4:.*]] = fir.address_of(@_QFEc4) : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>
+! CHECK-DAG: %[[P:.*]] = fir.address_of(@_QFEp) : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>
+
+! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[P_CAST:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[RANK:.*]] = arith.constant 0 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: fir.call @_FortranAAllocatableInitDerived(%[[P_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[C0]]) : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %[[P_CAST:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[P_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[C1_CAST:.*]] = fir.convert %0 : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[RANK:.*]] = arith.constant 0 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: fir.call @_FortranAAllocatableInitDerived(%[[C1_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[C0]]) : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %[[C1_CAST:.*]] = fir.convert %[[C1]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[C1_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+! CHECK: %[[TYPE_DESC_P2:.*]] = fir.address_of(@_QMpolyE.dt.p2) : !fir.ref<!fir.type<
+! CHECK: %[[C2_CAST:.*]] = fir.convert %[[C2]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_P2_CAST:.*]] = fir.convert %[[TYPE_DESC_P2]] : (!fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[RANK:.*]] = arith.constant 0 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: fir.call @_FortranAAllocatableInitDerived(%[[C2_CAST]], %[[TYPE_DESC_P2_CAST]], %[[RANK]], %[[C0]]) : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %[[C2_CAST:.*]] = fir.convert %[[C2]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[C2_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+! CHECK: %[[TYPE_DESC_P1:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_P1_CAST:.*]] = fir.convert %[[TYPE_DESC_P1]] : (!fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[RANK:.*]] = arith.constant 1 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: fir.call @_FortranAAllocatableInitDerived(%[[C3_CAST]], %[[TYPE_DESC_P1_CAST]], %[[RANK]], %[[C0]]) : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[C10:.*]] = arith.constant 10 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[C1_I64:.*]] = fir.convert %c1 : (index) -> i64
+! CHECK: %[[C10_I64:.*]] = fir.convert %[[C10]] : (i32) -> i64
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableSetBounds(%[[C3_CAST]], %[[C0]], %[[C1_I64]], %[[C10_I64]]) : (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[C3_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+! CHECK: %[[TYPE_DESC_P2:.*]] = fir.address_of(@_QMpolyE.dt.p2) : !fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_P2_CAST:.*]] = fir.convert %[[TYPE_DESC_P2]] : (!fir.ref<!fir.type<_QM__fortran_type_infoTderivedtype
+! CHECK: %[[RANK:.*]] = arith.constant 1 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: fir.call @_FortranAAllocatableInitDerived(%[[C4_CAST]], %[[TYPE_DESC_P2_CAST]], %[[RANK]], %[[C0]]) : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[C20:.*]] = arith.constant 20 : i32
+! CHECK: %[[C0:.*]] = arith.constant 0 : i32
+! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[C1_I64:.*]] = fir.convert %[[C1]] : (index) -> i64
+! CHECK: %[[C20_I64:.*]] = fir.convert %[[C20]] : (i32) -> i64
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableSetBounds(%[[C4_CAST]], %[[C0]], %[[C1_I64]], %[[C20_I64]]) : (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[C4_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+
+! Check code generation of allocate runtime calls for polymoprhic entities. This
+! is done from Fortran so we don't have a file full of auto-generated type info
+! in order to perform the checks.
+
+! LLVM-LABEL: define void @_QQmain()
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr @_QFEp, ptr @_QMpolyE.dt.p1, i32 0, i32 0)
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr @_QFEp, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr @_QFEc1, ptr @_QMpolyE.dt.p1, i32 0, i32 0)
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr @_QFEc1, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr @_QFEc2, ptr @_QMpolyE.dt.p2, i32 0, i32 0)
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr @_QFEc2, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr @_QFEc3, ptr @_QMpolyE.dt.p1, i32 1, i32 0)
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableSetBounds(ptr @_QFEc3, i32 0, i64 1, i64 10)
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr @_QFEc3, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr @_QFEc4, ptr @_QMpolyE.dt.p2, i32 1, i32 0)
+! LLVM: %{{.*}} = call {} @_FortranAAllocatableSetBounds(ptr @_QFEc4, i32 0, i64 1, i64 20)
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr @_QFEc4, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})