[flang] Lower polymorphic entities types in dummy argument and function result

This patch updates lowering to produce the correct fir.class types for
various polymorphic and unlimited polymoprhic entities cases. This is only the
lowering. Some TODOs have been added to the CodeGen part to avoid errors since
this part still need to be updated as well.
The fir.class<*> representation for unlimited polymorphic entities mentioned in
the document has been updated to fir.class<none> to avoid useless work in pretty
parse/printer.

This patch is part of the implementation of the poltymorphic
entities.
https://github.com/llvm/llvm-project/blob/main/flang/docs/PolymorphicEntities.md

Depends on D134957

Reviewed By: jeanPerier

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

diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h
index b2f6ea8..988c8e3 100644 (file)
--- a/flang/include/flang/Optimizer/Builder/BoxValue.h
+++ b/flang/include/flang/Optimizer/Builder/BoxValue.h
@@ -194,11 +194,11 @@ public:
                 llvm::ArrayRef<mlir::Value> extents)
       : AbstractBox{addr}, AbstractArrayBox(extents, lbounds) {}
   /// Get the fir.box<type> part of the address type.
-  fir::BoxType getBoxTy() const {
+  fir::BaseBoxType getBoxTy() const {
     auto type = getAddr().getType();
     if (auto pointedTy = fir::dyn_cast_ptrEleTy(type))
       type = pointedTy;
-    return type.cast<fir::BoxType>();
+    return type.cast<fir::BaseBoxType>();
   }
   /// Return the part of the address type after memory and box types. That is
   /// the element type, maybe wrapped in a fir.array type.

diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index ff0642b..5b835c3 100644 (file)
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -762,7 +762,7 @@ def fir_EmboxOp : fir_Op<"embox", [NoSideEffect, AttrSizedOperandSegments]> {
     OptionalAttr<AffineMapAttr>:$accessMap
   );
 
-  let results = (outs fir_BoxType);
+  let results = (outs BoxOrClassType);
 
   let builders = [
     OpBuilder<(ins "llvm::ArrayRef<mlir::Type>":$resultTypes,

diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index 390d4c3..482fec5 100644 (file)
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -87,7 +87,7 @@ inline bool isa_ref_type(mlir::Type t) {
 
 /// Is `t` a boxed type?
 inline bool isa_box_type(mlir::Type t) {
-  return t.isa<fir::BoxType, fir::BoxCharType, fir::BoxProcType>();
+  return t.isa<fir::BaseBoxType, fir::BoxCharType, fir::BoxProcType>();
 }
 
 /// Is `t` a type that is always trivially pass-by-reference? Specifically, this
@@ -307,6 +307,14 @@ inline bool BaseBoxType::classof(mlir::Type type) {
   return type.isa<fir::BoxType, fir::ClassType>();
 }
 
+/// Return a fir.box<T> or fir.class<T> if the type is polymorphic.
+inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
+                                       bool isPolymorphic = false) {
+  if (isPolymorphic)
+    return fir::ClassType::get(eleTy);
+  return fir::BoxType::get(eleTy);
+}
+
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIRTYPE_H

diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index 5c60230..b63d76c 100644 (file)
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -564,6 +564,10 @@ def fir_VoidType : FIR_Type<"Void", "void"> {
   let genStorageClass = 0;
 }
 
+// Whether a type is a BaseBoxType
+def IsBaseBoxTypePred
+        : CPred<"$_self.isa<::fir::BaseBoxType>()">;
+
 // Generalized FIR and standard dialect types representing intrinsic types
 def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
     AnySignedInteger.predicate, fir_IntegerType.predicate]>, "any integer">;
@@ -596,7 +600,11 @@ def RefOrLLVMPtr : TypeConstraint<Or<[fir_ReferenceType.predicate,
     fir_LLVMPointerType.predicate]>, "fir.ref or fir.llvm_ptr">;
 
 def AnyBoxLike : TypeConstraint<Or<[fir_BoxType.predicate,
-    fir_BoxCharType.predicate, fir_BoxProcType.predicate]>, "any box">;
+    fir_BoxCharType.predicate, fir_BoxProcType.predicate,
+    fir_ClassType.predicate]>, "any box">;
+
+def BoxOrClassType : TypeConstraint<Or<[fir_BoxType.predicate,
+    fir_ClassType.predicate]>, "box or class">;
 
 def AnyRefOrBoxLike : TypeConstraint<Or<[AnyReferenceLike.predicate,
     AnyBoxLike.predicate, FunctionType.predicate]>,

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 4f2ad1d..3f30cab 100644 (file)
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -183,6 +183,7 @@ std::optional<parser::Message> WhyNotModifiable(SourceName, const SomeExpr &,
     const Scope &, bool vectorSubscriptIsOk = false);
 const Symbol *IsExternalInPureContext(const Symbol &, const Scope &);
 bool HasCoarray(const parser::Expr &);
+bool IsPolymorphic(const Symbol &);
 bool IsPolymorphicAllocatable(const Symbol &);
 // Return an error if component symbol is not accessible from scope (7.5.4.8(2))
 std::optional<parser::MessageFormattedText> CheckAccessibleComponent(

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index ddf8fe9..583a519 100644 (file)
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -797,9 +797,8 @@ private:
     Fortran::common::TypeCategory cat = dynamicType.category();
     // DERIVED
     if (cat == Fortran::common::TypeCategory::Derived) {
-      if (dynamicType.IsPolymorphic())
-        TODO(interface.converter.getCurrentLocation(),
-             "support for polymorphic types");
+      if (dynamicType.IsUnlimitedPolymorphic())
+        return mlir::NoneType::get(&mlirContext);
       return getConverter().genType(dynamicType.GetDerivedTypeSpec());
     }
     // CHARACTER with compile time constant length.
@@ -860,16 +859,17 @@ private:
       type = fir::HeapType::get(type);
     if (obj.attrs.test(Attrs::Pointer))
       type = fir::PointerType::get(type);
-    mlir::Type boxType = fir::BoxType::get(type);
+    mlir::Type boxType =
+        fir::wrapInClassOrBoxType(type, obj.type.type().IsPolymorphic());
 
     if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
-      // Pass as fir.ref<fir.box>
+      // Pass as fir.ref<fir.box> or fir.ref<fir.class>
       mlir::Type boxRefType = fir::ReferenceType::get(boxType);
       addFirOperand(boxRefType, nextPassedArgPosition(), Property::MutableBox,
                     attrs);
       addPassedArg(PassEntityBy::MutableBox, entity, characteristics);
     } else if (dummyRequiresBox(obj)) {
-      // Pass as fir.box
+      // Pass as fir.box or fir.class
       if (isValueAttr)
         TODO(loc, "assumed shape dummy argument with VALUE attribute");
       addFirOperand(boxType, nextPassedArgPosition(), Property::Box, attrs);
@@ -954,12 +954,17 @@ private:
     assert(typeAndShape && "expect type for non proc pointer result");
     mlir::Type mlirType = translateDynamicType(typeAndShape->type());
     fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
+    const auto *resTypeAndShape{result.GetTypeAndShape()};
+    bool resIsPolymorphic =
+        resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
     if (!bounds.empty())
       mlirType = fir::SequenceType::get(bounds, mlirType);
     if (result.attrs.test(Attr::Allocatable))
-      mlirType = fir::BoxType::get(fir::HeapType::get(mlirType));
+      mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType),
+                                           resIsPolymorphic);
     if (result.attrs.test(Attr::Pointer))
-      mlirType = fir::BoxType::get(fir::PointerType::get(mlirType));
+      mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
+                                           resIsPolymorphic);
 
     if (fir::isa_char(mlirType)) {
       // Character scalar results must be passed as arguments in lowering so

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index cebb1a2..58b06ef 100644 (file)
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2390,10 +2390,10 @@ public:
                                   llvm::ArrayRef<mlir::Value> extents,
                                   llvm::ArrayRef<mlir::Value> lengths) {
     mlir::Type type = base.getType();
-    if (type.isa<fir::BoxType>())
+    if (type.isa<fir::BaseBoxType>())
       return fir::BoxValue(base, /*lbounds=*/{}, lengths, extents);
     type = fir::unwrapRefType(type);
-    if (type.isa<fir::BoxType>())
+    if (type.isa<fir::BaseBoxType>())
       return fir::MutableBoxValue(base, lengths, /*mutableProperties*/ {});
     if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
       if (seqTy.getDimension() != extents.size())

diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 772c850..2188f38 100644 (file)
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -233,8 +233,8 @@ struct TypeBuilder {
         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
         translateLenParameters(params, tySpec->category(), ultimate);
         ty = genFIRType(context, tySpec->category(), kind, params);
-      } else if (type->IsPolymorphic()) {
-        TODO(loc, "support for polymorphic types");
+      } else if (type->IsUnlimitedPolymorphic()) {
+        ty = mlir::NoneType::get(context);
       } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
                      type->AsDerived()) {
         ty = genDerivedType(*tySpec);
@@ -253,11 +253,12 @@ struct TypeBuilder {
       translateShape(shape, std::move(*shapeExpr));
       ty = fir::SequenceType::get(shape, ty);
     }
-
     if (Fortran::semantics::IsPointer(symbol))
-      return fir::BoxType::get(fir::PointerType::get(ty));
+      return fir::wrapInClassOrBoxType(
+          fir::PointerType::get(ty), Fortran::semantics::IsPolymorphic(symbol));
     if (Fortran::semantics::IsAllocatable(symbol))
-      return fir::BoxType::get(fir::HeapType::get(ty));
+      return fir::wrapInClassOrBoxType(
+          fir::HeapType::get(ty), Fortran::semantics::IsPolymorphic(symbol));
     // isPtr and isAlloc are variable that were promoted to be on the
     // heap or to be pointers, but they do not have Fortran allocatable
     // or pointer semantics, so do not use box for them.

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 3de87ca..9a1211a 100644 (file)
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -217,7 +217,7 @@ mlir::Value Fortran::lower::genInitialDataTarget(
       fir::ExtendedValue exv =
           globalOpSymMap.lookupSymbol(sym).toExtendedValue();
       const auto *mold = exv.getBoxOf<fir::MutableBoxValue>();
-      fir::BoxType boxType = mold->getBoxTy();
+      fir::BaseBoxType boxType = mold->getBoxTy();
       mlir::Value box =
           fir::factory::createUnallocatedBox(builder, loc, boxType, {});
       return box;
@@ -1650,7 +1650,7 @@ void Fortran::lower::mapSymbolAttributes(
         mlir::Value argBox;
         mlir::Type castTy = builder.getRefType(varType);
         if (addr) {
-          if (auto boxTy = addr.getType().dyn_cast<fir::BoxType>()) {
+          if (auto boxTy = addr.getType().dyn_cast<fir::BaseBoxType>()) {
             argBox = addr;
             mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
             addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);

diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 4bcb606..fe6abb4 100644 (file)
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -3806,7 +3806,7 @@ IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
          "MOLD argument required to lower NULL outside of any context");
   const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
   assert(mold && "MOLD must be a pointer or allocatable");
-  fir::BoxType boxType = mold->getBoxTy();
+  fir::BaseBoxType boxType = mold->getBoxTy();
   mlir::Value boxStorage = builder.createTemporary(loc, boxType);
   mlir::Value box = fir::factory::createUnallocatedBox(
       builder, loc, boxType, mold->nonDeferredLenParams());

diff --git a/flang/lib/Optimizer/Builder/BoxValue.cpp b/flang/lib/Optimizer/Builder/BoxValue.cpp
index cd70067..a75550a 100644 (file)
--- a/flang/lib/Optimizer/Builder/BoxValue.cpp
+++ b/flang/lib/Optimizer/Builder/BoxValue.cpp
@@ -185,7 +185,7 @@ bool fir::MutableBoxValue::verify() const {
   mlir::Type type = fir::dyn_cast_ptrEleTy(getAddr().getType());
   if (!type)
     return false;
-  auto box = type.dyn_cast<fir::BoxType>();
+  auto box = type.dyn_cast<fir::BaseBoxType>();
   if (!box)
     return false;
   // A boxed value always takes a memory reference,

diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index c06a1ff..00692d3 100644 (file)
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -320,7 +320,7 @@ mlir::Value
 fir::factory::createUnallocatedBox(fir::FirOpBuilder &builder,
                                    mlir::Location loc, mlir::Type boxType,
                                    mlir::ValueRange nonDeferredParams) {
-  auto baseAddrType = boxType.dyn_cast<fir::BoxType>().getEleTy();
+  auto baseAddrType = boxType.dyn_cast<fir::BaseBoxType>().getEleTy();
   if (!fir::isa_ref_type(baseAddrType))
     baseAddrType = builder.getRefType(baseAddrType);
   auto type = fir::unwrapRefType(baseAddrType);

diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
index 33acf48..1e40bea 100644 (file)
--- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
+++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
@@ -13,6 +13,7 @@
 #include "flang/Optimizer/CodeGen/CodeGen.h"
 
 #include "CGOps.h"
+#include "flang/Optimizer/Builder/Todo.h" // remove when TODO's are done
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
@@ -84,6 +85,8 @@ public:
     // If the embox does not include a shape, then do not convert it
     if (auto shapeVal = embox.getShape())
       return rewriteDynamicShape(embox, rewriter, shapeVal);
+    if (embox.getType().isa<fir::ClassType>())
+      TODO(embox.getLoc(), "embox conversion for fir.class type");
     if (auto boxTy = embox.getType().dyn_cast<fir::BoxType>())
       if (auto seqTy = boxTy.getEleTy().dyn_cast<fir::SequenceType>())
         if (!seqTy.hasDynamicExtents())
@@ -274,6 +277,8 @@ public:
     target.addIllegalOp<fir::ArrayCoorOp>();
     target.addIllegalOp<fir::ReboxOp>();
     target.addDynamicallyLegalOp<fir::EmboxOp>([](fir::EmboxOp embox) {
+      if (embox.getType().isa<fir::ClassType>())
+        TODO(embox.getLoc(), "fir.class type CodeGenRewrite");
       return !(embox.getShape() || embox.getType()
                                        .cast<fir::BoxType>()
                                        .getEleTy()

diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h
index c087bdf..b3730d2 100644 (file)
--- a/flang/lib/Optimizer/CodeGen/TypeConverter.h
+++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h
@@ -64,6 +64,10 @@ public:
       // procedure pointer feature is implemented.
       return llvm::None;
     });
+    addConversion([&](fir::ClassType classTy) {
+      TODO_NOLOC("fir.class type conversion");
+      return llvm::None;
+    });
     addConversion(
         [&](fir::CharacterType charTy) { return convertCharType(charTy); });
     addConversion(

diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 3c70627..01f3f12 100644 (file)
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -209,7 +209,7 @@ mlir::Type dyn_cast_ptrOrBoxEleTy(mlir::Type t) {
   return llvm::TypeSwitch<mlir::Type, mlir::Type>(t)
       .Case<fir::ReferenceType, fir::PointerType, fir::HeapType,
             fir::LLVMPointerType>([](auto p) { return p.getEleTy(); })
-      .Case<fir::BoxType>([](auto p) {
+      .Case<fir::BaseBoxType>([](auto p) {
         auto eleTy = p.getEleTy();
         if (auto ty = fir::dyn_cast_ptrEleTy(eleTy))
           return ty;
@@ -249,7 +249,7 @@ bool hasDynamicSize(mlir::Type t) {
 bool isPointerType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
-  if (auto boxTy = ty.dyn_cast<fir::BoxType>())
+  if (auto boxTy = ty.dyn_cast<fir::BaseBoxType>())
     return boxTy.getEleTy().isa<fir::PointerType>();
   return false;
 }
@@ -257,7 +257,7 @@ bool isPointerType(mlir::Type ty) {
 bool isAllocatableType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
-  if (auto boxTy = ty.dyn_cast<fir::BoxType>())
+  if (auto boxTy = ty.dyn_cast<fir::BaseBoxType>())
     return boxTy.getEleTy().isa<fir::HeapType>();
   return false;
 }
@@ -265,8 +265,8 @@ bool isAllocatableType(mlir::Type ty) {
 bool isUnlimitedPolymorphicType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
-  if (auto boxTy = ty.dyn_cast<fir::BoxType>())
-    return boxTy.getEleTy().isa<mlir::NoneType>();
+  if (auto clTy = ty.dyn_cast<fir::ClassType>())
+    return clTy.getEleTy().isa<mlir::NoneType>();
   return false;
 }
 

diff --git a/flang/test/Lower/polymorphic-types.f90 b/flang/test/Lower/polymorphic-types.f90
new file mode 100644 (file)
index 0000000..17008d1
--- /dev/null
+++ b/flang/test/Lower/polymorphic-types.f90
@@ -0,0 +1,176 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Tests the different possible type involving polymorphic entities. 
+
+module polymorphic_types
+  type p1
+    integer :: a
+    integer :: b
+  contains
+    procedure :: polymorphic_dummy
+  end type
+contains
+
+! ------------------------------------------------------------------------------
+! Test polymorphic entity types
+! ------------------------------------------------------------------------------
+
+  subroutine polymorphic_dummy(p)
+    class(p1) :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy(
+! CHECK-SAME: %{{.*}}: !fir.class<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>
+
+  subroutine polymorphic_dummy_assumed_shape_array(pa)
+    class(p1) :: pa(:)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy_assumed_shape_array(
+! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+
+  subroutine polymorphic_dummy_explicit_shape_array(pa)
+    class(p1) :: pa(10)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy_explicit_shape_array(
+! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+
+  subroutine polymorphic_allocatable(p)
+    class(p1), allocatable :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_allocatable(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+
+  subroutine polymorphic_pointer(p)
+    class(p1), pointer :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_pointer(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+
+  subroutine polymorphic_allocatable_intentout(p)
+    class(p1), allocatable, intent(out) :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_allocatable_intentout(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>) -> !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 unlimited polymorphic dummy argument types
+! ------------------------------------------------------------------------------
+
+  subroutine unlimited_polymorphic_dummy(u)
+    class(*) :: u
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_dummy(
+! CHECK-SAME: %{{.*}}: !fir.class<none>
+
+  subroutine unlimited_polymorphic_assumed_shape_array(ua)
+    class(*) :: ua(:)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_assumed_shape_array(
+! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<?xnone>>
+
+  subroutine unlimited_polymorphic_explicit_shape_array(ua)
+    class(*) :: ua(20)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_explicit_shape_array(
+! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<20xnone>>
+
+  subroutine unlimited_polymorphic_allocatable(p)
+    class(*), allocatable :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_allocatable(
+! 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>>>
+
+! ------------------------------------------------------------------------------
+! Test polymorphic function return types
+! ------------------------------------------------------------------------------
+
+  function ret_polymorphic_allocatable() result(ret)
+    class(p1), allocatable :: ret
+  end function
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_polymorphic_allocatable() -> !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_polymorphic_allocatableEret"}
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>
+! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+! CHECK: return %[[LOAD]] : !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+
+  function ret_polymorphic_pointer() result(ret)
+    class(p1), pointer :: ret
+  end function
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_polymorphic_pointer() -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_polymorphic_pointerEret"}
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>
+! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>) -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
+! CHECK: return %[[LOAD]] : !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>
+
+! ------------------------------------------------------------------------------
+! Test unlimited polymorphic function return types
+! ------------------------------------------------------------------------------
+
+  function ret_unlimited_polymorphic_allocatable() result(ret)
+    class(*), allocatable :: ret
+  end function
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_unlimited_polymorphic_allocatable() -> !fir.class<!fir.heap<none>>
+! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.heap<none>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_unlimited_polymorphic_allocatableEret"}
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<none>
+! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.heap<none>) -> !fir.class<!fir.heap<none>>
+! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: return %[[LOAD]] : !fir.class<!fir.heap<none>>
+
+  function ret_unlimited_polymorphic_pointer() result(ret)
+    class(*), pointer :: ret
+  end function
+
+! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_unlimited_polymorphic_pointer() -> !fir.class<!fir.ptr<none>>
+! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.ptr<none>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_unlimited_polymorphic_pointerEret"}
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<none>
+! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.ptr<none>) -> !fir.class<!fir.ptr<none>>
+! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: return %[[LOAD]] : !fir.class<!fir.ptr<none>>
+
+! ------------------------------------------------------------------------------
+! Test assumed type argument types
+! ------------------------------------------------------------------------------
+
+  ! Follow up patch will add a `fir.assumed_type` attribute to the types in the
+  ! two tests below.
+  subroutine assumed_type_dummy(a) bind(c)
+    type(*) :: a
+  end subroutine assumed_type_dummy
+
+  ! CHECK-LABEL: func.func @assumed_type_dummy(
+  ! CHECK-SAME: %{{.*}}: !fir.class<none>
+
+  subroutine assumed_type_dummy_array(a) bind(c)
+    type(*) :: a(:)
+  end subroutine assumed_type_dummy_array
+
+  ! CHECK-LABEL: func.func @assumed_type_dummy_array(
+  ! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<?xnone>>
+end module