[flang-commits] [flang] 9d99b48 - [flang] Lower polymorphic entities types in dummy argument and function result
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Oct 4 00:44:19 PDT 2022
Author: Valentin Clement
Date: 2022-10-04T09:43:59+02:00
New Revision: 9d99b482cdc288dabe5ec1924177238d438ef093
URL: https://github.com/llvm/llvm-project/commit/9d99b482cdc288dabe5ec1924177238d438ef093
DIFF: https://github.com/llvm/llvm-project/commit/9d99b482cdc288dabe5ec1924177238d438ef093.diff
LOG: [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
Added:
flang/test/Lower/polymorphic-types.f90
Modified:
flang/include/flang/Optimizer/Builder/BoxValue.h
flang/include/flang/Optimizer/Dialect/FIROps.td
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/include/flang/Optimizer/Dialect/FIRTypes.td
flang/include/flang/Semantics/tools.h
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/BoxValue.cpp
flang/lib/Optimizer/Builder/MutableBox.cpp
flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
flang/lib/Optimizer/CodeGen/TypeConverter.h
flang/lib/Optimizer/Dialect/FIRType.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h
index b2f6ea8aa2b12..988c8e34970fa 100644
--- a/flang/include/flang/Optimizer/Builder/BoxValue.h
+++ b/flang/include/flang/Optimizer/Builder/BoxValue.h
@@ -194,11 +194,11 @@ class AbstractIrBox : public AbstractBox, public AbstractArrayBox {
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 ff0642bf136ab..5b835c381c031 100644
--- 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 390d4c3fc8d67..482fec57a5d83 100644
--- 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 5c60230393c29..b63d76cc3ff06 100644
--- 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 4f2ad1d349506..3f30cab36296c 100644
--- 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 ddf8fe9bd2ccd..583a519b8f632 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -797,9 +797,8 @@ class Fortran::lower::CallInterfaceImpl {
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 @@ class Fortran::lower::CallInterfaceImpl {
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 @@ class Fortran::lower::CallInterfaceImpl {
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 cebb1a2acd4cf..58b06ef72b842 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2390,10 +2390,10 @@ class ScalarExprLowering {
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 772c8508b7c05..2188f38afd6d5 100644
--- 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 3de87ca9f4bc3..9a1211a9c30e0 100644
--- 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 4bcb6069a02be..fe6abb42aaaca 100644
--- 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 cd7006788de38..a75550ab9464b 100644
--- 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 c06a1ffa58bdc..00692d3a24849 100644
--- 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 33acf48088dd8..1e40bead7a55e 100644
--- 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 @@ class EmboxConversion : public mlir::OpRewritePattern<fir::EmboxOp> {
// 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 @@ class CodeGenRewrite : public fir::impl::CodeGenRewriteBase<CodeGenRewrite> {
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 c087bdfda7366..b3730d2608e12 100644
--- a/flang/lib/Optimizer/CodeGen/TypeConverter.h
+++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h
@@ -64,6 +64,10 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
// 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 3c70627b17449..01f3f1263720b 100644
--- 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
index 0000000000000..17008d1a49cce
--- /dev/null
+++ b/flang/test/Lower/polymorphic-types.f90
@@ -0,0 +1,176 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Tests the
diff erent 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
More information about the flang-commits
mailing list