[flang-commits] [flang] 0137123 - [flang] Handle polymorphic passed object in host association
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Dec 7 03:01:27 PST 2022
Author: Valentin Clement
Date: 2022-12-07T12:01:18+01:00
New Revision: 01371238463e87288f750c5ef74c6e13f991ffb5
URL: https://github.com/llvm/llvm-project/commit/01371238463e87288f750c5ef74c6e13f991ffb5
DIFF: https://github.com/llvm/llvm-project/commit/01371238463e87288f750c5ef74c6e13f991ffb5.diff
LOG: [flang] Handle polymorphic passed object in host association
Polymorphic entities are always emboxed. This patch
handles host association of polyrmophic entities as passed object.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D139423
Added:
Modified:
flang/lib/Lower/HostAssociations.cpp
flang/test/Lower/polymorphic.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index 65bc518b83b4a..9aff44c6e0c13 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -229,6 +229,32 @@ static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) {
return false;
}
+/// Class defining how polymorphic entities are captured in internal procedures.
+/// Polymorphic entities are always boxed as a fir.class box.
+class CapturedPolymorphic : public CapturedSymbols<CapturedPolymorphic> {
+public:
+ static mlir::Type getType(Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym) {
+ return fir::ClassType::get(converter.genType(sym));
+ }
+ static void instantiateHostTuple(const InstantiateHostTuple &args,
+ Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType());
+ assert(typeInTuple && "addrInTuple must be an address");
+ mlir::Value castBox = builder.createConvert(args.loc, typeInTuple,
+ fir::getBase(args.hostValue));
+ builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple);
+ }
+ static void getFromTuple(const GetFromTuple &args,
+ Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym,
+ const Fortran::lower::BoxAnalyzer &ba) {
+ args.symMap.addSymbol(sym, args.valueInTuple);
+ }
+};
+
/// Class defining how allocatable and pointers entities are captured in
/// internal procedures. Allocatable and pointers are simply captured by placing
/// their !fir.ref<fir.box<>> address in the host tuple.
@@ -423,6 +449,12 @@ walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
ba.analyze(sym);
if (Fortran::semantics::IsAllocatableOrPointer(sym))
return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba);
+ if (Fortran::semantics::IsPolymorphic(sym)) {
+ if (ba.isArray() && !ba.lboundIsAllOnes())
+ TODO(converter.genLocation(sym.name()),
+ "polymorphic array with non default lower bound");
+ return CapturedPolymorphic::visit(visitor, converter, sym, ba);
+ }
if (ba.isArray())
return CapturedArrays::visit(visitor, converter, sym, ba);
if (ba.isChar())
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index ce8eff0b1a7ab..28465060fa4ac 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -10,6 +10,7 @@ module polymorphic_test
procedure :: print
procedure :: assign_p1_int
generic :: assignment(=) => assign_p1_int
+ procedure :: host_assoc
end type
type, extends(p1) :: p2
@@ -39,6 +40,14 @@ elemental subroutine assign_p1_int(lhs, rhs)
lhs%b = rhs
End Subroutine
+! CHECK-LABEL: func.func @_QMpolymorphic_testPhost_assoc(
+! CHECK-SAME: %[[THIS:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {
+! CHECK: %[[TUPLE:.*]] = fir.alloca tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: %[[POS_IN_TUPLE:.*]] = arith.constant 0 : i32
+! CHECK: %[[COORD_OF_CLASS:.*]] = fir.coordinate_of %[[TUPLE]], %[[POS_IN_TUPLE]] : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, i32) -> !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: fir.store %[[THIS]] to %[[COORD_OF_CLASS]] : !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: fir.call @_QMpolymorphic_testFhost_assocPinternal(%[[TUPLE]]) {{.*}} : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> ()
+
! Test correct access to polymorphic entity component.
subroutine component_access(p)
class(p1) :: p
@@ -413,4 +422,28 @@ subroutine test_elemental_assign()
! CHECK: fir.array_merge_store %[[LOAD_PA]], %[[DO_RES]] to %[[PA]] : !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.ref<!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
! CHECK: return
+ subroutine host_assoc(this)
+ class(p1) :: this
+
+ call internal
+ contains
+ subroutine internal
+ print*, this%a, this%b
+ end subroutine
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testFhost_assocPinternal(
+! CHECK-SAME: %[[TUPLE:.*]]: !fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.host_assoc}) {
+! CHECK: %[[POS_IN_TUPLE:.*]] = arith.constant 0 : i32
+! CHECK: %[[COORD_OF_CLASS:.*]] = fir.coordinate_of %[[TUPLE]], %[[POS_IN_TUPLE]] : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, i32) -> !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: %[[CLASS:.*]] = fir.load %[[COORD_OF_CLASS]] : !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
+! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[CLASS]], %[[FIELD_A]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.field) -> !fir.ref<i32>
+! CHECK: %[[A:.*]] = fir.load %[[COORD_A]] : !fir.ref<i32>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[A]]) {{.*}} : (!fir.ref<i8>, i32) -> i1
+! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
+! CHECK: %[[COORD_B:.*]] = fir.coordinate_of %[[CLASS]], %[[FIELD_B]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.field) -> !fir.ref<i32>
+! CHECK: %[[B:.*]] = fir.load %[[COORD_B]] : !fir.ref<i32>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[B]]) {{.*}} : (!fir.ref<i8>, i32) -> i1
+
end module
More information about the flang-commits
mailing list