[flang] Update intrinsic types to unlimited polymorphic form

This patch updates the code added in D143888 to avoid overwriting some part of the types when updating it for unlimited polymorphic types. Reviewed By: jeanPerier, PeteSteinfeld Differential Revision: https://reviews.llvm.org/D143995
llvm · Feb 15, 2023 · e1d95e9 · e1d95e9
1 parent 11c3cea
commit e1d95e9
Show file tree

Hide file tree

Showing 4 changed files with 126 additions and 2 deletions.
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -344,6 +344,27 @@ inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
   return fir::BoxType::get(eleTy);
 }
 
+/// Return the elementType where intrinsic types are replaced with none for
+/// unlimited polymorphic entities.
+///
+/// i32 -> none
+/// !fir.array<2xf32> -> !fir.array<2xnone>
+/// !fir.heap<!fir.array<2xf32>> -> !fir.heap<!fir.array<2xnone>>
+inline mlir::Type updateTypeForUnlimitedPolymorphic(mlir::Type ty) {
+  if (auto seqTy = ty.dyn_cast<fir::SequenceType>())
+    return fir::SequenceType::get(
+        seqTy.getShape(), updateTypeForUnlimitedPolymorphic(seqTy.getEleTy()));
+  if (auto heapTy = ty.dyn_cast<fir::HeapType>())
+    return fir::HeapType::get(
+        updateTypeForUnlimitedPolymorphic(heapTy.getEleTy()));
+  if (auto pointerTy = ty.dyn_cast<fir::PointerType>())
+    return fir::PointerType::get(
+        updateTypeForUnlimitedPolymorphic(pointerTy.getEleTy()));
+  if (!ty.isa<mlir::NoneType, fir::RecordType>())
+    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<fir::BaseBoxType>();

diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -512,8 +512,7 @@ mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
   mlir::Type boxTy = fir::BoxType::get(elementType);
   mlir::Value tdesc;
   if (isPolymorphic) {
-    if (!elementType.isa<mlir::NoneType, fir::RecordType>())
-      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
@@ -353,6 +353,40 @@ subroutine pass_trivial_to_up()
 ! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.complex<4>>) -> !fir.class<none>
 ! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class<none>) -> ()
 
+  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.array<2x!fir.char<1>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>
+! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_CHAR]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()
+
+! CHECK: %[[BOX_INT:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>
+! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_INT]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()
+
+! CHECK: %[[BOX_REAL:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>
+! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_REAL]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()
+
+! CHECK: %[[BOX_LOG:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>
+! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_LOG]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()
+
+! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2x!fir.complex<4>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>
+! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()
+
   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
@@ -146,3 +146,73 @@ TEST_F(FIRTypesTest, isBoxedRecordType) {
   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<T> -> !fir.type<T>
+  mlir::Type recTy = fir::RecordType::get(&context, "dt");
+  EXPECT_EQ(recTy, fir::updateTypeForUnlimitedPolymorphic(recTy));
+
+  // !fir.array<2x!fir.type<T>> -> !fir.array<2x!fir.type<T>>
+  mlir::Type arrRecTy = fir::SequenceType::get({2}, recTy);
+  EXPECT_EQ(arrRecTy, fir::updateTypeForUnlimitedPolymorphic(arrRecTy));
+
+  // !fir.heap<!fir.type<T>> -> !fir.heap<!fir.type<T>>
+  mlir::Type heapTy = fir::HeapType::get(recTy);
+  EXPECT_EQ(heapTy, fir::updateTypeForUnlimitedPolymorphic(heapTy));
+  // !fir.heap<!fir.array<2x!fir.type<T>>> ->
+  // !fir.heap<!fir.array<2x!fir.type<T>>>
+  mlir::Type heapArrTy = fir::HeapType::get(arrRecTy);
+  EXPECT_EQ(heapArrTy, fir::updateTypeForUnlimitedPolymorphic(heapArrTy));
+
+  // !fir.ptr<!fir.type<T>> -> !fir.ptr<!fir.type<T>>
+  mlir::Type ptrTy = fir::PointerType::get(recTy);
+  EXPECT_EQ(ptrTy, fir::updateTypeForUnlimitedPolymorphic(ptrTy));
+  // !fir.ptr<!fir.array<2x!fir.type<T>>> ->
+  // !fir.ptr<!fir.array<2x!fir.type<T>>>
+  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);
+  llvm::SmallVector<mlir::Type> 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<TY> -> !fir.heap<none>
+    mlir::Type heapTy = fir::HeapType::get(ty);
+    EXPECT_EQ(heapNone, fir::updateTypeForUnlimitedPolymorphic(heapTy));
+
+    // !fir.heap<!fir.array<10xTY>> -> !fir.heap<!fir.array<10xnone>>
+    mlir::Type heapArrTy = fir::HeapType::get(arrTy);
+    EXPECT_EQ(heapArrNone, fir::updateTypeForUnlimitedPolymorphic(heapArrTy));
+
+    // !fir.ptr<TY> -> !fir.ptr<none>
+    mlir::Type ptrTy = fir::PointerType::get(ty);
+    EXPECT_EQ(ptrNone, fir::updateTypeForUnlimitedPolymorphic(ptrTy));
+
+    // !fir.ptr<!fir.array<10xTY>> -> !fir.ptr<!fir.array<10xnone>>
+    mlir::Type ptrArrTy = fir::PointerType::get(arrTy);
+    EXPECT_EQ(ptrArrNone, fir::updateTypeForUnlimitedPolymorphic(ptrArrTy));
+  }
+}