[flang] Update to fir::isUnlimitedPolymorphicType and fir::isPolymorphicType functions

[clementval]

Summary

This patch update the fir::isUnlimitedPolymorphicType function
to reflect the chosen design. It adds also a fir::isPolymorphicType
function.

[jeanPerier]

Looks good to me, but logic depends on your answer about TYPE(*) in D135141 (if should be fir.box<None> or fir.class<None, assumed type>).

[clementval]

In D135143#3833232, @jeanPerier wrote:

Looks good to me, but logic depends on your answer about TYPE(*) in D135141 (if should be fir.box<None> or fir.class<None, assumed type>).

So in that case, if we use fir.box<none> for TYPE(*), the function should return true since assumed type entities are unlimited polymorphic. Since we are using fir.box<none> in the lowering currently with any boxed entities, they will all get a true return for isUnlimitedPolymorphic. I don't think that is a real issue but I just wanted to raise it.

[jeanPerier]

In D135143#3833270, @clementval wrote:

In D135143#3833232, @jeanPerier wrote:

Looks good to me, but logic depends on your answer about TYPE(*) in D135141 (if should be fir.box<None> or fir.class<None, assumed type>).

So in that case, if we use fir.box<none> for TYPE(*), the function should return true since assumed type entities are unlimited polymorphic. Since we are using fir.box<none> in the lowering currently with any boxed entities, they will all get a true return for isUnlimitedPolymorphic. I don't think that is a real issue but I just wanted to raise it.

Good point. On our current usage of fir.box<None>, I think this is OK.

[clementval]

Update after change in D135141. Also add isPolymorphicType

[jeanPerier]

Looks good

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

 
 /// Return true iff `ty` is the type of a POINTER entity or value.
 /// `isa_ref_type()` can be used to distinguish.
 bool isPointerType(mlir::Type ty);
 
 /// Return true iff `ty` is the type of an ALLOCATABLE entity or value.
 bool isAllocatableType(mlir::Type ty);
 
+/// Return true iff `ty` is the type of an polymorphic entity or
+/// value.
+bool isPolymorphicType(mlir::Type ty);
+
 /// Return true iff `ty` is the type of an unlimited polymorphic entity or
 /// value.
 bool isUnlimitedPolymorphicType(mlir::Type ty);
 
 /// Return true iff `ty` is a RecordType with members that are allocatable.
 bool isRecordWithAllocatableMember(mlir::Type ty);
 
 /// Return true iff `ty` is a RecordType with type parameters.

flang/lib/Optimizer/Dialect/FIRType.cpp

 bool isAllocatableType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
   if (auto boxTy = ty.dyn_cast<fir::BaseBoxType>())
     return boxTy.getEleTy().isa<fir::HeapType>();
   return false;
 }
 
+static bool isAssumedType(mlir::Type ty) {
+  if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
+    if (boxTy.getEleTy().isa<mlir::NoneType>())
+      return true;
+    if (auto seqTy = boxTy.getEleTy().dyn_cast<fir::SequenceType>())
+      return seqTy.getEleTy().isa<mlir::NoneType>();
+  }
+  return false;
+}
+
+bool isPolymorphicType(mlir::Type ty) {
+  if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
+    ty = refTy;
+  // CLASS(*)
+  if (ty.isa<fir::ClassType>())
+    return true;
+  // assumed type are polymorphic.
+  return isAssumedType(ty);
+}
+
 bool isUnlimitedPolymorphicType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
-  if (auto clTy = ty.dyn_cast<fir::ClassType>())
-    return clTy.getEleTy().isa<mlir::NoneType>();
-  return false;
+  // CLASS(*)
+  if (auto clTy = ty.dyn_cast<fir::ClassType>()) {
+    if (clTy.getEleTy().isa<mlir::NoneType>())
+      return true;
+    mlir::Type innerType =
+        llvm::TypeSwitch<mlir::Type, mlir::Type>(clTy.getEleTy())
+            .Case<fir::PointerType, fir::HeapType, fir::SequenceType>(
+                [](auto ty) {
+                  mlir::Type eleTy = ty.getEleTy();
+                  if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
+                    return seqTy.getEleTy();
+                  return eleTy;
+                })
+            .Default([](mlir::Type) { return mlir::Type{}; });
+    return innerType.isa<mlir::NoneType>();
+  }
+  // TYPE(*)
+  return isAssumedType(ty);
 }
 
 bool isRecordWithAllocatableMember(mlir::Type ty) {
   if (auto recTy = ty.dyn_cast<fir::RecordType>())
     for (auto [field, memTy] : recTy.getTypeList()) {
       if (fir::isAllocatableType(memTy))
         return true;
       // A record type cannot recursively include itself as a direct member.

flang/unittests/Optimizer/CMakeLists.txt

add_flang_unittest(FlangOptimizerTests
   Builder/Runtime/CharacterTest.cpp
   Builder/Runtime/DerivedTest.cpp
   Builder/Runtime/NumericTest.cpp
   Builder/Runtime/RaggedTest.cpp
   Builder/Runtime/ReductionTest.cpp
   Builder/Runtime/StopTest.cpp
   Builder/Runtime/TransformationalTest.cpp
   FIRContextTest.cpp
+  FIRTypesTest.cpp
   InternalNamesTest.cpp
   KindMappingTest.cpp
   RTBuilder.cpp
 )
 target_link_libraries(FlangOptimizerTests
   PRIVATE
   ${LIBS})

flang/unittests/Optimizer/FIRTypesTest.cpp

+//===- FIRTypesTest.cpp ---------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "gtest/gtest.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Support/InitFIR.h"
+
+struct FIRTypesTest : public testing::Test {
+public:
+  void SetUp() { fir::support::loadDialects(context); }
+
+  mlir::MLIRContext context;
+};
+
+// Test fir::isPolymorphicType from flang/Optimizer/Dialect/FIRType.h.
+TEST_F(FIRTypesTest, isPolymorphicTypeTest) {
+  mlir::Type noneTy = mlir::NoneType::get(&context);
+  mlir::Type seqNoneTy =
+      fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, noneTy);
+  mlir::Type recTy = fir::RecordType::get(&context, "dt");
+  mlir::Type seqRecTy =
+      fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, recTy);
+
+  // CLASS(T)
+  mlir::Type ty = fir::ClassType::get(recTy);
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+  EXPECT_TRUE(fir::isPolymorphicType(fir::ReferenceType::get(ty)));
+
+  // CLASS(T), DIMENSION(10)
+  ty = fir::ClassType::get(fir::SequenceType::get({10}, recTy));
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(T), DIMENSION(:)
+  ty = fir::ClassType::get(seqRecTy);
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(T), ALLOCATABLE
+  ty = fir::ClassType::get(fir::HeapType::get(recTy));
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(T), ALLOCATABLE, DIMENSION(:)
+  ty = fir::ClassType::get(fir::HeapType::get(seqRecTy));
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(T), POINTER
+  ty = fir::ClassType::get(fir::PointerType::get(recTy));
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(T), POINTER, DIMENSIONS(:)
+  ty = fir::ClassType::get(fir::PointerType::get(seqRecTy));
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+
+  // CLASS(*)
+  ty = fir::ClassType::get(noneTy);
+  EXPECT_TRUE(fir::isPolymorphicType(ty));
+  EXPECT_TRUE(fir::isPolymorphicType(fir::ReferenceType::get(ty)));
+
+  // TYPE(*)
+  EXPECT_TRUE(fir::isPolymorphicType(fir::BoxType::get(noneTy)));
+
+  // TYPE(*), DIMENSION(:)
+  EXPECT_TRUE(fir::isPolymorphicType(fir::BoxType::get(seqNoneTy)));
+
+  // false tests
+  EXPECT_FALSE(fir::isPolymorphicType(noneTy));
+  EXPECT_FALSE(fir::isPolymorphicType(seqNoneTy));
+}
+
+// Test fir::isUnlimitedPolymorphicType from flang/Optimizer/Dialect/FIRType.h.
+TEST_F(FIRTypesTest, isUnlimitedPolymorphicTypeTest) {
+  mlir::Type noneTy = mlir::NoneType::get(&context);
+  mlir::Type seqNoneTy =
+      fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, noneTy);
+
+  // CLASS(*)
+  mlir::Type ty = fir::ClassType::get(noneTy);
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(fir::ReferenceType::get(ty)));
+
+  // CLASS(*), DIMENSION(10)
+  ty = fir::ClassType::get(fir::SequenceType::get({10}, noneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // CLASS(*), DIMENSION(:)
+  ty = fir::ClassType::get(
+      fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, noneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // CLASS(*), ALLOCATABLE
+  ty = fir::ClassType::get(fir::HeapType::get(noneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // CLASS(*), ALLOCATABLE, DIMENSION(:)
+  ty = fir::ClassType::get(fir::HeapType::get(seqNoneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // CLASS(*), POINTER
+  ty = fir::ClassType::get(fir::PointerType::get(noneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // CLASS(*), POINTER, DIMENSIONS(:)
+  ty = fir::ClassType::get(fir::PointerType::get(seqNoneTy));
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(ty));
+
+  // TYPE(*)
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(fir::BoxType::get(noneTy)));
+
+  // TYPE(*), DIMENSION(:)
+  EXPECT_TRUE(fir::isUnlimitedPolymorphicType(fir::BoxType::get(seqNoneTy)));
+
+  // false tests
+  EXPECT_FALSE(fir::isUnlimitedPolymorphicType(noneTy));
+  EXPECT_FALSE(fir::isUnlimitedPolymorphicType(seqNoneTy));
+}