[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

diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index 6820e9b..9d88445 100644 (file)
--- 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
index 5d57c36..88519bc 100644 (file)
--- 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
index f7013fe..9525ba9 100644 (file)
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -353,6 +353,40 @@ module polymorphic_test
 ! 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
index 580415e..e30800a 100644 (file)
--- 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));
+  }
+}