[flang-commits] [flang] f1307d7 - [flang] Handle polymorphic passed object in elemental call
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Dec 8 00:48:24 PST 2022
Author: Valentin Clement
Date: 2022-12-08T09:48:17+01:00
New Revision: f1307d78c6369fd02fb0159e4fb331438c3548d5
URL: https://github.com/llvm/llvm-project/commit/f1307d78c6369fd02fb0159e4fb331438c3548d5
DIFF: https://github.com/llvm/llvm-project/commit/f1307d78c6369fd02fb0159e4fb331438c3548d5.diff
LOG: [flang] Handle polymorphic passed object in elemental call
The passed object is placed in the passed arguments by semantics.
When the TBP to be called is an elemental subroutine or function it has to be
handled accordingly.
Reviewed By: jeanPerier, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D139537
Added:
Modified:
flang/lib/Lower/ConvertExpr.cpp
flang/test/Lower/polymorphic.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 6883bcd68a6ed..3a73a8b133521 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -4654,6 +4654,37 @@ class ArrayExprLowering {
} break;
case PassBy::Box:
case PassBy::MutableBox:
+ // Handle polymorphic passed object.
+ if (fir::isPolymorphicType(argTy)) {
+ if (isArray(*expr)) {
+ ExtValue exv = asScalarRef(*expr);
+ mlir::Value tdesc;
+ if (fir::isPolymorphicType(fir::getBase(exv).getType())) {
+ mlir::Type tdescType =
+ fir::TypeDescType::get(mlir::NoneType::get(builder.getContext()));
+ tdesc = builder.create<fir::BoxTypeDescOp>(
+ loc, tdescType, fir::getBase(exv));
+ }
+ mlir::Type baseTy =
+ fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(exv).getType());
+ mlir::Type innerTy = llvm::TypeSwitch<mlir::Type, mlir::Type>(baseTy)
+ .Case<fir::SequenceType>([](auto ty) { return ty.getEleTy(); })
+ .Default([](mlir::Type t) {return t; });
+
+ operands.emplace_back([=](IterSpace iters) -> ExtValue {
+ mlir::Value coord = builder.create<fir::CoordinateOp>(
+ loc, fir::ReferenceType::get(innerTy), fir::getBase(exv), iters.iterVec());
+ mlir::Value empty;
+ mlir::ValueRange emptyRange;
+ return builder.create<fir::EmboxOp>(loc, fir::ClassType::get(innerTy),
+ coord, empty, empty, emptyRange, tdesc);
+ });
+ } else {
+ PushSemantics(ConstituentSemantics::BoxValue);
+ operands.emplace_back(genElementalArgument(*expr));
+ }
+ break;
+ }
// See C15100 and C15101
fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE");
}
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 28465060fa4ac..e6338237890d5 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -9,6 +9,7 @@ module polymorphic_test
contains
procedure :: print
procedure :: assign_p1_int
+ procedure :: elemental_fct
generic :: assignment(=) => assign_p1_int
procedure :: host_assoc
end type
@@ -48,6 +49,11 @@ elemental subroutine assign_p1_int(lhs, rhs)
! 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}>>>>) -> ()
+ elemental integer function elemental_fct(this)
+ class(p1), intent(In) :: this
+ elemental_fct = this%a
+ end function
+
! Test correct access to polymorphic entity component.
subroutine component_access(p)
class(p1) :: p
@@ -446,4 +452,95 @@ subroutine internal
! CHECK: %[[B:.*]] = fir.load %[[COORD_B]] : !fir.ref<i32>
! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[B]]) {{.*}} : (!fir.ref<i8>, i32) -> i1
+ subroutine test_elemental_array()
+ type(p1) :: p(5)
+ print *, p%elemental_fct()
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_array() {
+! CHECK: %[[P:.*]] = fir.alloca !fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_elemental_arrayEp"}
+! CHECK: %[[C5:.*]] = arith.constant 5 : index
+! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5xi32>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>
+! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[UB:.*]] = arith.subi %[[C5]], %[[C1]] : index
+! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG1:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.ref<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[RES:.*]] = fir.call @_QMpolymorphic_testPelemental_fct(%[[EMBOXED]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG1]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
+! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5xi32>>
+
+ subroutine test_elemental_poly_array(p)
+ class(p1) :: p(5)
+ print *, p%elemental_fct()
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_poly_array(
+! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {
+! CHECK: %[[C5:.*]] = arith.constant 5 : index
+! CHECK: %[[TDESC:.*]] = fir.box_tdesc %[[P]] : (!fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.tdesc<none>
+! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5xi32>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>
+! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[UB:.*]] = arith.subi %[[C5]], %[[C1]] : index
+! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%15 : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 {pass_arg_pos = 0 : i32}
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
+! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5xi32>>
+
+ subroutine test_elemental_poly_array_2d(p)
+ class(p1) :: p(5,5)
+ print *, p%elemental_fct()
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_poly_array_2d(
+! CHECK-SAME: %[[P]]: !fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {
+! CHECK: %[[C5:.*]] = arith.constant 5 : index
+! CHECK: %[[C5_0:.*]] = arith.constant 5 : index
+! CHECK: %[[TDESC:.*]] = fir.box_tdesc %[[P]] : (!fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.tdesc<none>
+! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5x5xi32>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]], %[[C5_0]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5x5xi32>>, !fir.shape<2>) -> !fir.array<5x5xi32>
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[UB0:.*]] = arith.subi %[[C5]], %[[C1]] : index
+! CHECK: %[[UB1:.*]] = arith.subi %[[C5_0]], %[[C1]] : index
+! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND0:.*]] = %[[C0]] to %[[UB1]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5x5xi32>) {
+! CHECK: %[[LOOP_RES0:.*]] = fir.do_loop %[[IND1:.*]] = %[[C0]] to %[[UB0]] step %[[C1]] unordered iter_args(%[[ARG0:.*]] = %[[ARG]]) -> (!fir.array<5x5xi32>) {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND1]], %[[IND0]] : (!fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%17 : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 {pass_arg_pos = 0 : i32}
+! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG0]], %[[RES]], %[[IND1]], %[[IND0]] : (!fir.array<5x5xi32>, i32, index, index) -> !fir.array<5x5xi32>
+! CHECK: fir.result %[[ARR_UP]] : !fir.array<5x5xi32>
+! CHECK: }
+! CHECK: fir.result %[[LOOP_RES0]] : !fir.array<5x5xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5x5xi32>, !fir.array<5x5xi32>, !fir.heap<!fir.array<5x5xi32>>
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]], %[[C5_0]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5x5xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<5x5xi32>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5x5xi32>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>) -> i1
+! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5x5xi32>>
+
end module
More information about the flang-commits
mailing list