[flang-commits] [flang] 9470169 - [flang] Handle unlimited polymorphic with intrinsic dynamic type in extends_type_of

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-10T09:49:58+01:00
New Revision: 9470169fcbe93ccf9f97b56bfb23c636e32133d8

URL: https://github.com/llvm/llvm-project/commit/9470169fcbe93ccf9f97b56bfb23c636e32133d8
DIFF: https://github.com/llvm/llvm-project/commit/9470169fcbe93ccf9f97b56bfb23c636e32133d8.diff

LOG: [flang] Handle unlimited polymorphic with intrinsic dynamic type in extends_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

Added: 
    

Modified: 
    flang/runtime/derived-api.cpp
    flang/unittests/Runtime/Derived.cpp

Removed: 
    


################################################################################
diff  --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp
index 8f66a8e65f123..9b3455d9f0293 100644
--- a/flang/runtime/derived-api.cpp
+++ b/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)};
 

diff  --git a/flang/unittests/Runtime/Derived.cpp b/flang/unittests/Runtime/Derived.cpp
index 89306c82f5d90..019d5e8309e4a 100644
--- a/flang/unittests/Runtime/Derived.cpp
+++ b/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));
+}