From 3eef2c2b1383a5a4ce20f0c92bf7d31537f87705 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 4 Oct 2022 21:29:28 +0200 Subject: [PATCH] [flang] Lower TYPE(*) as fir.box This patch lowers `TYPE(*)` correctly to fir.box. Reviewed By: jeanPerier Differential Revision: https://reviews.llvm.org/D135141 --- flang/docs/PolymorphicEntities.md | 7 ++++++- flang/include/flang/Optimizer/Dialect/FIRType.h | 15 ++++++++++++--- flang/include/flang/Semantics/tools.h | 1 + flang/lib/Lower/CallInterface.cpp | 10 ++++++---- flang/lib/Semantics/tools.cpp | 7 +++++++ flang/test/Lower/polymorphic-types.f90 | 6 ++---- 6 files changed, 34 insertions(+), 12 deletions(-) diff --git a/flang/docs/PolymorphicEntities.md b/flang/docs/PolymorphicEntities.md index 362b899..8993112 100644 --- a/flang/docs/PolymorphicEntities.md +++ b/flang/docs/PolymorphicEntities.md @@ -104,8 +104,13 @@ func.func @bar(%x : !fir.class) 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.box`. ### SELECT TYPE construct diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index 482fec5..5246071 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -307,10 +307,19 @@ inline bool BaseBoxType::classof(mlir::Type type) { return type.isa(); } -/// Return a fir.box or fir.class if the type is polymorphic. +/// 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. If the type +/// is polymorphic and assumed shape return fir.box. inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy, - bool isPolymorphic = false) { - if (isPolymorphic) + bool isPolymorphic = false, + bool isAssumedType = false) { + if (isPolymorphic && !isAssumedType) return fir::ClassType::get(eleTy); return fir::BoxType::get(eleTy); } diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index 3f30cab..c497966 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -183,6 +183,7 @@ std::optional WhyNotModifiable(SourceName, const SomeExpr &, 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 index 583a519..510cb60 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -859,8 +859,8 @@ private: type = fir::HeapType::get(type); if (obj.attrs.test(Attrs::Pointer)) type = fir::PointerType::get(type); - mlir::Type boxType = - fir::wrapInClassOrBoxType(type, obj.type.type().IsPolymorphic()); + mlir::Type boxType = 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 @@ private: 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/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index f575480..4b57f14 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1059,6 +1059,13 @@ bool HasCoarray(const parser::Expr &expression) { 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/Lower/polymorphic-types.f90 b/flang/test/Lower/polymorphic-types.f90 index 17008d1..49175ec 100644 --- a/flang/test/Lower/polymorphic-types.f90 +++ b/flang/test/Lower/polymorphic-types.f90 @@ -158,19 +158,17 @@ contains ! 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 + ! CHECK-SAME: %{{.*}}: !fir.box 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.box> end module -- 2.7.4