[flang] Update intrinsic types to unlimited polymorphic form

[clementval]

Summary

This patch updates the code added in D143888 to avoid
overwriting some part of the types when updating it
for unlimited polymorphic types.

[jeanPerier]

flang/unittests/Optimizer/FIRTypesTest.cpp

150

The unit test seems to fail somewhere in a dyn_cast.

[clementval]

flang/unittests/Optimizer/FIRTypesTest.cpp

150

I'll try to reproduce this on my machine.

[clementval]

Switch from TypeRange to SmallVector<mlir::Type>

[PeteSteinfeld]

All builds and tests correctly for me using GCC 9.3.0. But you should fix Jean's problem before updating.

flang/include/flang/Optimizer/Dialect/FIRType.h

347

"intrinsic type" should read "intrinsic types"

353

This function seems to call itself recursively. Given that, what's the effect of the "inline" declaration?

[clementval]

In D143995#4126714, @PeteSteinfeld wrote:

All builds and tests correctly for me using GCC 9.3.0. But you should fix Jean's problem before updating.

Test is passing now.

[PeteSteinfeld]

In that case, ship it!

[jeanPerier]

LGTM

flang/include/flang/Optimizer/Dialect/FIRType.h

353

In C++, 'the meaning of the keyword inline for functions came to mean "multiple definitions are permitted" rather than "inlining is preferred"' (quote from [1]).

The keyword "inline" allows one to define a (non-member) function in a header that may be included in several compilation unit (it would otherwise be an error since there would be multiple definition). Hence it is required here.

It is actually not a guarantee that the compiler will inline the function at the call sites, but only a strong hint to try. So there is no issue using it on recursive functions: the C++ compiler won't blindly inline it again and again until it blows.

See [1] for a better explanation.

[1] https://en.cppreference.com/w/cpp/language/inline

flang/include/flang/Optimizer/Dialect/FIRType.h

 inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
                                        bool isPolymorphic = false,
                                        bool isAssumedType = false) {
   if (isPolymorphic && !isAssumedType)
     return fir::ClassType::get(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>();
 }
 
 /// Is `t` a fir.box or class address or value type?
 inline bool isBoxAddressOrValue(mlir::Type t) {
   return fir::unwrapRefType(t).isa<fir::BaseBoxType>();
 }
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIRTYPE_H

flang/lib/Optimizer/Builder/FIRBuilder.cpp

mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
   if (!elementType) {
     mlir::emitError(loc, "internal: expected a memory reference type ")
         << itemAddr.getType();
     llvm_unreachable("not a memory reference type");
   }
   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);
   }
 
   return exv.match(
       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
         mlir::Value empty;
         mlir::ValueRange emptyRange;
         mlir::Value s = createShape(loc, exv);

flang/test/Lower/polymorphic.f90

 ! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_REAL]]) {{.*}} : (!fir.class<none>) -> ()
 
 ! CHECK: %[[BOX_LOG:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.logical<4>>) -> !fir.class<none>
 ! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_LOG]]) {{.*}} : (!fir.class<none>) -> ()
 
 ! 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(:,:)
     c = t
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPassign_polymorphic_allocatable() {
 ! CHECK: %[[C:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "c", uniq_name = "_QMpolymorphic_testFassign_polymorphic_allocatableEc"}

flang/unittests/Optimizer/FIRTypesTest.cpp

TEST_F(FIRTypesTest, isBoxedRecordType) {
 
   // TYPE(T), DIMENSION(:)
   ty = fir::BoxType::get(seqRecTy);
   EXPECT_TRUE(fir::isBoxedRecordType(ty));
 
   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));
+  }
+}