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 @@ -344,6 +344,27 @@ return fir::BoxType::get(eleTy); } +/// Return the elementType where intrinsic type are replaced with none for +/// unlimited polymorphic entities. +/// +/// i32 -> none +/// !fir.array<2xf32> -> !fir.array<2xnone> +/// !fir.heap> -> !fir.heap> +inline mlir::Type updateTypeForUnlimitedPolymorphic(mlir::Type ty) { + if (auto seqTy = ty.dyn_cast()) + return fir::SequenceType::get( + seqTy.getShape(), updateTypeForUnlimitedPolymorphic(seqTy.getEleTy())); + if (auto heapTy = ty.dyn_cast()) + return fir::HeapType::get( + updateTypeForUnlimitedPolymorphic(heapTy.getEleTy())); + if (auto pointerTy = ty.dyn_cast()) + return fir::PointerType::get( + updateTypeForUnlimitedPolymorphic(pointerTy.getEleTy())); + if (!ty.isa()) + return mlir::NoneType::get(ty.getContext()); + return ty; +} + /// Is `t` an address to fir.box or class type? inline bool isBoxAddress(mlir::Type t) { return fir::isa_ref_type(t) && fir::unwrapRefType(t).isa(); diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -512,8 +512,7 @@ mlir::Type boxTy = fir::BoxType::get(elementType); mlir::Value tdesc; if (isPolymorphic) { - if (!elementType.isa()) - elementType = mlir::NoneType::get(elementType.getContext()); + elementType = fir::updateTypeForUnlimitedPolymorphic(elementType); boxTy = fir::ClassType::get(elementType); } diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -353,6 +353,40 @@ ! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}} : (!fir.ref>) -> !fir.class ! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class) -> () + subroutine up_arr_input(a) + class(*), intent(in) :: a(2) + end subroutine + + subroutine pass_trivial_arr_to_up() + character :: c(2) + integer :: i(2) + real :: r(2) + logical :: l(2) + complex :: cx(2) + + call up_arr_input(c) + call up_arr_input(i) + call up_arr_input(r) + call up_arr_input(l) + call up_arr_input(cx) + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPpass_trivial_arr_to_up() { +! CHECK: %[[BOX_CHAR:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.class> +! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_CHAR]]) {{.*}} : (!fir.class>) -> () + +! CHECK: %[[BOX_INT:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.class> +! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_INT]]) {{.*}} : (!fir.class>) -> () + +! CHECK: %[[BOX_REAL:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.class> +! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_REAL]]) {{.*}} : (!fir.class>) -> () + +! CHECK: %[[BOX_LOG:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.class> +! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_LOG]]) {{.*}} : (!fir.class>) -> () + +! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.class> +! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class>) -> () + subroutine assign_polymorphic_allocatable() type(p1), target :: t(10,20) class(p1), allocatable :: c(:,:) diff --git a/flang/unittests/Optimizer/FIRTypesTest.cpp b/flang/unittests/Optimizer/FIRTypesTest.cpp --- a/flang/unittests/Optimizer/FIRTypesTest.cpp +++ b/flang/unittests/Optimizer/FIRTypesTest.cpp @@ -146,3 +146,72 @@ EXPECT_FALSE(fir::isBoxedRecordType(fir::BoxType::get( fir::ReferenceType::get(mlir::IntegerType::get(&context, 32))))); } + +TEST_F(FIRTypesTest, updateTypeForUnlimitedPolymorphic) { + // RecordType are not changed. + + // !fir.tyep -> !fir.type + mlir::Type recTy = fir::RecordType::get(&context, "dt"); + EXPECT_EQ(recTy, fir::updateTypeForUnlimitedPolymorphic(recTy)); + + // !fir.array<2x!fir.type> -> !fir.array<2x!fir.type> + mlir::Type arrRecTy = fir::SequenceType::get({2}, recTy); + EXPECT_EQ(arrRecTy, fir::updateTypeForUnlimitedPolymorphic(arrRecTy)); + + // !fir.heap> -> !fir.heap> + mlir::Type heapTy = fir::HeapType::get(recTy); + EXPECT_EQ(heapTy, fir::updateTypeForUnlimitedPolymorphic(heapTy)); + // !fir.heap>> -> + // !fir.heap>> + mlir::Type heapArrTy = fir::HeapType::get(arrRecTy); + EXPECT_EQ(heapArrTy, fir::updateTypeForUnlimitedPolymorphic(heapArrTy)); + + // !fir.ptr> -> !fir.ptr> + mlir::Type ptrTy = fir::PointerType::get(recTy); + EXPECT_EQ(ptrTy, fir::updateTypeForUnlimitedPolymorphic(ptrTy)); + // !fir.ptr>> -> + // !fir.ptr>> + mlir::Type ptrArrTy = fir::PointerType::get(arrRecTy); + EXPECT_EQ(ptrArrTy, fir::updateTypeForUnlimitedPolymorphic(ptrArrTy)); + + // When updating intrinsic types the array, pointer and heap types are kept. + // only the inner element type is changed to `none`. + mlir::Type none = mlir::NoneType::get(&context); + mlir::Type arrNone = fir::SequenceType::get({10}, none); + mlir::Type heapNone = fir::HeapType::get(none); + mlir::Type heapArrNone = fir::HeapType::get(arrNone); + mlir::Type ptrNone = fir::PointerType::get(none); + mlir::Type ptrArrNone = fir::PointerType::get(arrNone); + + mlir::Type i32Ty = mlir::IntegerType::get(&context, 32); + mlir::Type f32Ty = mlir::FloatType::getF32(&context); + mlir::Type l1Ty = fir::LogicalType::get(&context, 1); + mlir::Type cplx4Ty = fir::ComplexType::get(&context, 4); + mlir::Type char1Ty = fir::CharacterType::get(&context, 1, 10); + mlir::TypeRange intrinsicTypes = {i32Ty, f32Ty, l1Ty, cplx4Ty, char1Ty}; + + for (mlir::Type ty : intrinsicTypes) { + // `ty` -> none + EXPECT_EQ(none, fir::updateTypeForUnlimitedPolymorphic(ty)); + + // !fir.array<10xTY> -> !fir.array<10xnone> + mlir::Type arrTy = fir::SequenceType::get({10}, ty); + EXPECT_EQ(arrNone, fir::updateTypeForUnlimitedPolymorphic(arrTy)); + + // !fir.heap -> !fir.heap + mlir::Type heapTy = fir::HeapType::get(ty); + EXPECT_EQ(heapNone, fir::updateTypeForUnlimitedPolymorphic(heapTy)); + + // !fir.heap> -> !fir.heap> + mlir::Type heapArrTy = fir::HeapType::get(arrTy); + EXPECT_EQ(heapArrNone, fir::updateTypeForUnlimitedPolymorphic(heapArrTy)); + + // !fir.ptr -> !fir.ptr + mlir::Type ptrTy = fir::PointerType::get(ty); + EXPECT_EQ(ptrNone, fir::updateTypeForUnlimitedPolymorphic(ptrTy)); + + // !fir.ptr> -> !fir.ptr> + mlir::Type ptrArrTy = fir::PointerType::get(arrTy); + EXPECT_EQ(ptrArrNone, fir::updateTypeForUnlimitedPolymorphic(ptrArrTy)); + } +}