diff --git a/flang/docs/PolymorphicEntities.md b/flang/docs/PolymorphicEntities.md --- a/flang/docs/PolymorphicEntities.md +++ b/flang/docs/PolymorphicEntities.md @@ -104,8 +104,13 @@ Assumed type is added in Fortran 2018 and it is available only for dummy arguments. It's mainly used for interfaces to non-Fortran code and is similar to C's `void`. +An entity that is declared using the `TYPE(*)` type specifier is assumed-type +and is an unlimited polymorphic entity. It is not declared to have a type, and +is not considered to have the same declared type as any other entity, +including another unlimited polymorphic entity. Its dynamic type and type +parameters are assumed from its effective argument (7.3.2.2 - 3). -Assumed-type is represented as `!fir.type<*>`. +Assumed-type is represented in FIR as `!fir.class {fir.assumed_type}`. ### SELECT TYPE construct diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -307,11 +307,22 @@ return type.isa(); } +/// Return true iff `ty` is none or fir.array. +inline bool isNoneOrSeqNone(mlir::Type type) { + if (auto seqTy = type.dyn_cast()) + return seqTy.getEleTy().isa(); + return type.isa(); +} + /// Return a fir.box or fir.class if the type is polymorphic. inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy, - bool isPolymorphic = false) { - if (isPolymorphic) + bool isPolymorphic = false, + bool isAssumedType = false) { + if (isPolymorphic) { + if (isAssumedType) + return fir::ClassType::get(eleTy, mlir::UnitAttr::get(eleTy.getContext())); return fir::ClassType::get(eleTy); + } return fir::BoxType::get(eleTy); } diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td --- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td +++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td @@ -146,16 +146,24 @@ is equivalent to a fir.box type with a dynamic type. }]; - let parameters = (ins "mlir::Type":$eleTy); + let parameters = (ins "mlir::Type":$eleTy, "mlir::UnitAttr":$assumedType); let builders = [ - TypeBuilderWithInferredContext<(ins "mlir::Type":$eleTy), [{ - return $_get(eleTy.getContext(), eleTy); - }]> + TypeBuilderWithInferredContext<(ins + "mlir::Type":$eleTy, + CArg<"mlir::UnitAttr", "{}">:$assumedType), [{ + return $_get(eleTy.getContext(), eleTy, assumedType); + }]> ]; let genVerifyDecl = 1; - let assemblyFormat = "`<` $eleTy `>`"; + let hasCustomAssemblyFormat = 1; + + let extraClassDeclaration = [{ + static constexpr llvm::StringRef getAssumedTypeAttrName() { + return "assumed_type"; + } + }]; } def fir_ComplexType : FIR_Type<"Complex", "complex"> { diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -183,6 +183,7 @@ const Scope &, bool vectorSubscriptIsOk = false); const Symbol *IsExternalInPureContext(const Symbol &, const Scope &); bool HasCoarray(const parser::Expr &); +bool IsAssumedType(const Symbol &); bool IsPolymorphic(const Symbol &); bool IsPolymorphicAllocatable(const Symbol &); // Return an error if component symbol is not accessible from scope (7.5.4.8(2)) diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -860,7 +860,7 @@ if (obj.attrs.test(Attrs::Pointer)) type = fir::PointerType::get(type); mlir::Type boxType = - fir::wrapInClassOrBoxType(type, obj.type.type().IsPolymorphic()); + fir::wrapInClassOrBoxType(type, obj.type.type().IsPolymorphic(), obj.type.type().IsAssumedType()); if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) { // Pass as fir.ref or fir.ref @@ -957,14 +957,16 @@ const auto *resTypeAndShape{result.GetTypeAndShape()}; bool resIsPolymorphic = resTypeAndShape && resTypeAndShape->type().IsPolymorphic(); + bool resIsAssumedType = + resTypeAndShape && resTypeAndShape->type().IsAssumedType(); if (!bounds.empty()) mlirType = fir::SequenceType::get(bounds, mlirType); if (result.attrs.test(Attr::Allocatable)) mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType), - resIsPolymorphic); + resIsPolymorphic, resIsAssumedType); if (result.attrs.test(Attr::Pointer)) mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType), - resIsPolymorphic); + resIsPolymorphic, resIsAssumedType); if (fir::isa_char(mlirType)) { // Character scalar results must be passed as arguments in lowering so diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -446,13 +446,44 @@ mlir::LogicalResult fir::ClassType::verify(llvm::function_ref emitError, - mlir::Type eleTy) { + mlir::Type eleTy, mlir::UnitAttr assumedType) { if (eleTy.isa()) + fir::PointerType, mlir::NoneType>()) { + if (assumedType && !fir::isNoneOrSeqNone(eleTy)) + return emitError() << getAssumedTypeAttrName() + << " expect none element type\n"; return mlir::success(); + } return emitError() << "invalid element type\n"; } +mlir::Type fir::ClassType::parse(mlir::AsmParser &parser) { + if (parser.parseLess()) + return {}; + mlir::Type eleTy; + if (parser.parseType(eleTy)) + return {}; + bool isAssumedType = false; + if (!parser.parseOptionalComma()) { + if (!parser.parseKeyword(getAssumedTypeAttrName())) + isAssumedType = true; + else + return {}; + } + if (parser.parseGreater()) + return {}; + if (isAssumedType) + return fir::ClassType::get(eleTy, mlir::UnitAttr::get(parser.getContext())); + return fir::ClassType::get(eleTy); +} + +void fir::ClassType::print(mlir::AsmPrinter &printer) const { + printer << "<" << getEleTy(); + if (getAssumedType()) + printer << ", " << getAssumedTypeAttrName(); + printer << '>'; +} + //===----------------------------------------------------------------------===// // ComplexType //===----------------------------------------------------------------------===// diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1059,6 +1059,13 @@ return false; } +bool IsAssumedType(const Symbol &symbol) { + if (const DeclTypeSpec * type{symbol.GetType()}) { + return type->IsAssumedType(); + } + return false; +} + bool IsPolymorphic(const Symbol &symbol) { if (const DeclTypeSpec * type{symbol.GetType()}) { return type->IsPolymorphic(); diff --git a/flang/test/Fir/fir-types.fir b/flang/test/Fir/fir-types.fir --- a/flang/test/Fir/fir-types.fir +++ b/flang/test/Fir/fir-types.fir @@ -123,3 +123,4 @@ func.func private @class6() -> !fir.class> func.func private @class7() -> !fir.class> func.func private @class8() -> !fir.class> +func.func private @class9(!fir.class) -> () diff --git a/flang/test/Fir/invalid-types.fir b/flang/test/Fir/invalid-types.fir --- a/flang/test/Fir/invalid-types.fir +++ b/flang/test/Fir/invalid-types.fir @@ -165,5 +165,5 @@ // ----- -// expected-error@+1 {{invalid element type}} -func.func private @upe() -> !fir.class> +// expected-error@+1 {{expected 'assumed_type'}} +func.func private @upe(!fir.class) -> () diff --git a/flang/test/Lower/polymorphic-types.f90 b/flang/test/Lower/polymorphic-types.f90 --- a/flang/test/Lower/polymorphic-types.f90 +++ b/flang/test/Lower/polymorphic-types.f90 @@ -165,12 +165,12 @@ end subroutine assumed_type_dummy ! CHECK-LABEL: func.func @assumed_type_dummy( - ! CHECK-SAME: %{{.*}}: !fir.class + ! CHECK-SAME: %{{.*}}: !fir.class 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> + ! CHECK-SAME: %{{.*}}: !fir.class, assumed_type> end module