[flang] Handle unlimited polymorphic with intrinsic dynamic type in e…

…xtends_type_of

Unlimited polymorphic entities can have an intrinsic dynamic type. Update the
code of extends_type_of to compare the CFI_type in these case.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D145722

flang/runtime/derived-api.cpp

@@ -110,6 +110,10 @@ bool RTNAME(SameTypeAs)(const Descriptor &a, const Descriptor &b) {
 }
 
 bool RTNAME(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) {
+  if (a.raw().type != CFI_type_struct && a.raw().type != CFI_type_other &&
+      mold.raw().type != CFI_type_struct && mold.raw().type != CFI_type_other)
+    return a.raw().type == mold.raw().type;
+
   const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)};
   const typeInfo::DerivedType *derivedTypeMold{GetDerivedType(mold)};
 

flang/unittests/Runtime/Derived.cpp

@@ -51,3 +51,16 @@ TEST(Derived, SameTypeAs) {
   EXPECT_FALSE(RTNAME(SameTypeAs)(*i1, *p1));
   EXPECT_FALSE(RTNAME(SameTypeAs)(*p1, *i1));
 }
+
+TEST(Derived, ExtendsTypeOf) {
+  // CLASS(*), POINTER :: i1 - INTEGER dynamic type
+  auto i1{
+      Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Integer, 4}, 4,
+          nullptr, 0, nullptr, CFI_attribute_pointer)};
+  EXPECT_TRUE(RTNAME(ExtendsTypeOf)(*i1, *i1));
+
+  // CLASS(*), POINTER :: r1 - REAL dynamic type
+  auto r1{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
+      4, nullptr, 0, nullptr, CFI_attribute_pointer)};
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*i1, *r1));
+}