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

[clementval]

Summary

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

[jeanPerier]

A few questions. Overall looks great, I will have a more in depth look on Monday.

flang/include/flang/Optimizer/Dialect/FIROps.td

765

Will fir.embox -> fir.class will always be equivalent to fir.embox -> fir.box -> fir.convert -> fir.class, or will there be special cases where creating a fir.class via fir.embox would could not be implemented as a statically typed fir.box converted to a fir.class (I guess in order to be passed ? to a polymorphic dummy).

Doesn't Rebox_Op needs the same update ?

flang/include/flang/Optimizer/Dialect/FIRType.h

90

Can't fir::BaseBoxType replace the fir::BoxType and fir::ClassType occurrences ?

flang/lib/Lower/CallInterface.cpp

801

I dot not remember, is dynamicType.GetDerivedTypeSpec() not legal when dynamicType.IsUnlimitedPolymorphic() ?

[clementval]

flang/include/flang/Optimizer/Dialect/FIROps.td

765

As you mentioned some cases will require to update the type with the dynamic type.

Yes rebox will need the same update. I did not change it yet since there was no test case that cover it.

flang/include/flang/Optimizer/Dialect/FIRType.h

90

Yes. I'll update it.

flang/lib/Lower/CallInterface.cpp

801

dynamicType.GetDerivedTypeSpec() would return a nullptr when the dynamic type is unlimited polymorphic. So in that case we return directly the NoneType.

[clementval]

Update isa_box_type

[jeanPerier]

Other than the TYPE(*) test, LGTM.

flang/test/Lower/polymorphic-types.f90

157

Would it make sense to add a TYPE(*) test, or is it not yet possible to lower them ?

[clementval]

flang/test/Lower/polymorphic-types.f90

157

TYPE(*) is in fact already lowered. I'll add tests before pushing. I'm planning a separate patch to update the doc and add an attribute for TYPE(*) representation.

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

 /// Base class for values associated to a fir.box or fir.ref<fir.box>.
 class AbstractIrBox : public AbstractBox, public AbstractArrayBox {
 public:
   AbstractIrBox(mlir::Value addr) : AbstractBox{addr} {}
   AbstractIrBox(mlir::Value addr, llvm::ArrayRef<mlir::Value> lbounds,
                 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.
   mlir::Type getBaseTy() const {
     return fir::dyn_cast_ptrOrBoxEleTy(getBoxTy());
   }
 
   /// Return the memory type of the data address inside the box:

flang/include/flang/Optimizer/Dialect/FIROps.td

def fir_EmboxOp : fir_Op<"embox", [NoSideEffect, AttrSizedOperandSegments]> {
   let arguments = (ins
     AnyReferenceLike:$memref,
     Optional<AnyShapeType>:$shape,
     Optional<fir_SliceType>:$slice,
     Variadic<AnyIntegerType>:$typeparams,
     OptionalAttr<AffineMapAttr>:$accessMap
   );
 
-  let results = (outs fir_BoxType);
+  let results = (outs BoxOrClassType);
 
   let builders = [
     OpBuilder<(ins "llvm::ArrayRef<mlir::Type>":$resultTypes,
       "mlir::Value":$memref, CArg<"mlir::Value", "{}">:$shape,
       CArg<"mlir::Value", "{}">:$slice,
       CArg<"mlir::ValueRange", "{}">:$typeparams),
     [{ return build($_builder, $_state, resultTypes, memref, shape, slice,
                     typeparams, mlir::AffineMapAttr{}); }]>

flang/include/flang/Optimizer/Dialect/FIRType.h

 /// Is `t` a FIR dialect type that implies a memory (de)reference?
 inline bool isa_ref_type(mlir::Type t) {
   return t.isa<fir::ReferenceType, fir::PointerType, fir::HeapType,
                fir::LLVMPointerType>();
 }
 
 /// 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
 /// is testing if `t` is a ReferenceType or any box type. Compare this to
 /// conformsWithPassByRef(), which includes pointers and allocatables.
 inline bool isa_passbyref_type(mlir::Type t) {
   return t.isa<fir::ReferenceType, mlir::FunctionType>() || isa_box_type(t);
 }

 /// Convert llvm::Type::TypeID to mlir::Type
 mlir::Type fromRealTypeID(mlir::MLIRContext *context, llvm::Type::TypeID typeID,
                           fir::KindTy kind);
 
 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

flang/include/flang/Optimizer/Dialect/FIRTypes.td

let builders = [
     }]>,
   ];
 }
 
 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">;
 def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
     fir_LogicalType.predicate]>, "any logical">;
 def AnyRealLike : TypeConstraint<Or<[FloatLike.predicate,
     fir_RealType.predicate]>, "any real">;
 def AnyIntegerType : Type<AnyIntegerLike.predicate, "any integer">;

 
 def AnyCodeOrDataRefLike : TypeConstraint<Or<[AnyReferenceLike.predicate,
     FunctionType.predicate]>, "any code or data reference">;
 
 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]>,
     "any reference or box like">;
 def AnyRefOrBox : TypeConstraint<Or<[fir_ReferenceType.predicate,
     fir_HeapType.predicate, fir_PointerType.predicate, fir_BoxType.predicate]>,
     "any reference or box">;
 

flang/include/flang/Semantics/tools.h

 bool IsExternal(const Symbol &);
 bool IsModuleProcedure(const Symbol &);
 // Is the symbol modifiable in this scope
 std::optional<parser::Message> WhyNotModifiable(const Symbol &, const Scope &);
 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(
     const semantics::Scope &, const Symbol &);
 
 // Analysis of image control statements
 bool IsImageControlStmt(const parser::ExecutableConstruct &);
 // Get the location of the image control statement in this ExecutableConstruct

flang/lib/Lower/CallInterface.cpp

bool dummyRequiresBox(
     return false;
   }
 
   mlir::Type
   translateDynamicType(const Fortran::evaluate::DynamicType &dynamicType) {
     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.
     if (cat == Fortran::common::TypeCategory::Character)
       if (std::optional<std::int64_t> constantLen =
               toInt64(dynamicType.GetCharLength()))
         return getConverter().genType(cat, dynamicType.kind(), {*constantLen});
     // INTEGER, REAL, LOGICAL, COMPLEX, and CHARACTER with dynamic length.
void handleExplicitDummy(
     mlir::Type type = translateDynamicType(dynamicType);
     fir::SequenceType::Shape bounds = getBounds(obj.type.shape());
     if (!bounds.empty())
       type = fir::SequenceType::get(bounds, type);
     if (obj.attrs.test(Attrs::Allocatable))
       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);
       addPassedArg(PassEntityBy::Box, entity, characteristics);
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Character) {
       // Pass as fir.box_char
       mlir::Type boxCharTy =
void handleExplicitResult(
     if (result.IsProcedurePointer())
       TODO(interface.converter.getCurrentLocation(),
            "procedure pointer results");
     const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
         result.GetTypeAndShape();
     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
       // that an assumed length character function callee can access the result
       // length. A function with a result requiring an explicit interface does
       // not have to be compatible with assumed length function, but most
       // compilers supports it.
       handleImplicitCharacterResult(typeAndShape->type());

flang/lib/Lower/ConvertExpr.cpp

ExtValue genStmtFunctionRef(const Fortran::evaluate::ProcedureRef &procRef) {
     return result;
   }
 
   /// Helper to package a Value and its properties into an ExtendedValue.
   static ExtValue toExtendedValue(mlir::Location loc, mlir::Value base,
                                   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())
         fir::emitFatalError(loc, "incorrect number of extents for array");
       if (seqTy.getEleTy().isa<fir::CharacterType>()) {
         if (lengths.empty())
           fir::emitFatalError(loc, "missing length for character");
         assert(lengths.size() == 1);

flang/lib/Lower/ConvertType.cpp

if (Fortran::semantics::IsProcedurePointer(ultimate))
       TODO(loc, "procedure pointers");
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
         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);
       } else {
         fir::emitFatalError(loc, "symbol's type must have a type spec");
       }
     } else {
       fir::emitFatalError(loc, "symbol must have a type");
     }
     if (ultimate.IsObjectArray()) {
       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
           converter.getFoldingContext()}(ultimate);
       if (!shapeExpr)
         TODO(loc, "assumed rank symbol type");
       fir::SequenceType::Shape shape;
       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.
     if (isPtr)
       return fir::PointerType::get(ty);
     if (isAlloc)
       return fir::HeapType::get(ty);
     return ty;

flang/lib/Lower/ConvertVariable.cpp

if (intrinsic && intrinsic->name == "null") {
              "Expecting mold argument for NULL intrinsic");
       const auto *argExpr = procRef->arguments()[0].value().UnwrapExpr();
       assert(argExpr);
       const Fortran::semantics::Symbol *sym =
           Fortran::evaluate::GetFirstSymbol(*argExpr);
       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;
     }
   }
 
   mlir::Value box;
   if (initialTarget.Rank() > 0) {
ba.match(
         if (genUnusedEntryPointBox())
           return;
         // cast to the known constant parts from the declaration
         mlir::Type varType = converter.genType(var);
         mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
         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);
           }
           addr = builder.createConvert(loc, castTy, addr);
         }
         if (x.lboundAllOnes()) {
           // if lower bounds are all ones, build simple shaped object

flang/lib/Lower/IntrinsicCall.cpp

 fir::ExtendedValue
 IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
   // NULL() without MOLD must be handled in the contexts where it can appear
   // (see table 16.5 of Fortran 2018 standard).
   assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
          "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());
   builder.create<fir::StoreOp>(loc, box, boxStorage);
   return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
 }
 
 // PACK

flang/lib/Optimizer/Builder/BoxValue.cpp

 
 /// Debug verifier for MutableBox ctor. There is no guarantee that this will
 /// always be called, so it should not have any functional side effects,
 /// the const is here to enforce that.
 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,
 
   auto nParams = lenParams.size();
   if (isCharacter()) {
     if (nParams > 1)
       return false;

flang/lib/Optimizer/Builder/MutableBox.cpp

 };
 
 } // namespace
 
 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);
   auto eleTy = fir::unwrapSequenceType(type);
   if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
     if (recTy.getNumLenParams() > 0)
       TODO(loc, "creating unallocated fir.box of derived type with length "
                 "parameters");

flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp

 //===-- PreCGRewrite.cpp --------------------------------------------------===//
 //
 // 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/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"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "mlir/Transforms/DialectConversion.h"
 #include "llvm/ADT/STLExtras.h"
 #include "llvm/Support/Debug.h"
 
public:
   using OpRewritePattern::OpRewritePattern;
 
   mlir::LogicalResult
   matchAndRewrite(fir::EmboxOp embox,
                   mlir::PatternRewriter &rewriter) const override {
     // 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())
           return rewriteStaticShape(embox, rewriter, seqTy);
     return mlir::failure();
   }
 
   mlir::LogicalResult rewriteStaticShape(fir::EmboxOp embox,
void runOn(mlir::Operation *op, mlir::Region &region) {
     auto &context = getContext();
     mlir::OpBuilder rewriter(&context);
     mlir::ConversionTarget target(context);
     target.addLegalDialect<mlir::arith::ArithDialect, fir::FIROpsDialect,
                            fir::FIRCodeGenDialect, mlir::func::FuncDialect>();
     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()
                                        .isa<fir::SequenceType>());
     });
     mlir::RewritePatternSet patterns(&context);
     patterns.insert<EmboxConversion, ArrayCoorConversion, ReboxConversion>(
         &context);

flang/lib/Optimizer/CodeGen/TypeConverter.h

addConversion([&](BoxCharType boxchar) {
       LLVM_DEBUG(llvm::dbgs() << "type convert: " << boxchar << '\n');
       return convertType(specifics->boxcharMemoryType(boxchar.getEleTy()));
     });
     addConversion([&](BoxProcType boxproc) {
       // TODO: Support for this type will be added later when the Fortran 2003
       // 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(
         [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); });
     addConversion([&](fir::FieldType field) {
       // Convert to i32 because of LLVM GEP indexing restriction.
       return mlir::IntegerType::get(field.getContext(), 32);
     });

flang/lib/Optimizer/Dialect/FIRType.cpp

return llvm::TypeSwitch<mlir::Type, mlir::Type>(t)
             fir::LLVMPointerType>([](auto p) { return p.getEleTy(); })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
 
 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;
         return eleTy;
       })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
 
bool hasDynamicSize(mlir::Type t) {
   if (auto rec = t.dyn_cast<fir::RecordType>())
     return hasDynamicSize(rec);
   return false;
 }
 
 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;
 }
 
 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;
 }
 
 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;
 }
 
 bool isRecordWithAllocatableMember(mlir::Type ty) {
   if (auto recTy = ty.dyn_cast<fir::RecordType>())
     for (auto [field, memTy] : recTy.getTypeList()) {
       if (fir::isAllocatableType(memTy))
         return true;

flang/test/Lower/polymorphic-types.f90

+! 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