[flang-commits] [flang] 188c02d - [flang] Simplify same_type_as condition

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-09T15:47:39+01:00
New Revision: 188c02daaa24a484507a5e20db475180e793ccfd

URL: https://github.com/llvm/llvm-project/commit/188c02daaa24a484507a5e20db475180e793ccfd
DIFF: https://github.com/llvm/llvm-project/commit/188c02daaa24a484507a5e20db475180e793ccfd.diff

LOG: [flang] Simplify same_type_as condition

Restore the behavior changed in D145384 and add proper
unit tests.

Unallocated unlimited poymorphic allocatable and disassociated
unlimited polymorphic pointer should return false.

Reviewed By: PeteSteinfeld

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

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 4cceace94c6b0..8f66a8e65f123 100644
--- a/flang/runtime/derived-api.cpp
+++ b/flang/runtime/derived-api.cpp
@@ -95,12 +95,9 @@ bool RTNAME(SameTypeAs)(const Descriptor &a, const Descriptor &b) {
   const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)};
   const typeInfo::DerivedType *derivedTypeB{GetDerivedType(b)};
 
-  // One of the descriptor is an unallocated unlimited polymorphic descriptor.
-  // This is processor depedent according to the standard. Align the result
-  // with other compilers.
-  if ((!a.IsAllocated() && derivedTypeA == nullptr) ||
-      (!b.IsAllocated() && derivedTypeB == nullptr)) {
-    return true;
+  // No dynamic type in one or both descriptor.
+  if (derivedTypeA == nullptr || derivedTypeB == nullptr) {
+    return false;
   }
 
   // Exact match of derived type.

diff  --git a/flang/unittests/Runtime/Derived.cpp b/flang/unittests/Runtime/Derived.cpp
index 7e54367780204..89306c82f5d90 100644
--- a/flang/unittests/Runtime/Derived.cpp
+++ b/flang/unittests/Runtime/Derived.cpp
@@ -24,21 +24,30 @@ TEST(Derived, SameTypeAs) {
       4, nullptr, 0, nullptr, CFI_attribute_pointer)};
   EXPECT_FALSE(RTNAME(SameTypeAs)(*i1, *r1));
 
-  // CLASS(*), ALLOCATABLE :: p1
-  auto p1{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
+  // CLASS(*), ALLOCATABLE :: a1
+  auto a1{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
       4, nullptr, 0, nullptr, CFI_attribute_allocatable)};
-  p1->raw().elem_len = 0;
-  p1->raw().type = CFI_type_other;
+  a1->raw().elem_len = 0;
+  a1->raw().type = CFI_type_other;
 
-  EXPECT_TRUE(RTNAME(SameTypeAs)(*i1, *p1));
-  EXPECT_TRUE(RTNAME(SameTypeAs)(*p1, *i1));
-  EXPECT_TRUE(RTNAME(SameTypeAs)(*r1, *p1));
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*i1, *a1));
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*a1, *i1));
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*r1, *a1));
 
-  // CLASS(*), ALLOCATABLE :: p2
-  auto p2{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
+  // CLASS(*), ALLOCATABLE :: a2
+  auto a2{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
       4, nullptr, 0, nullptr, CFI_attribute_allocatable)};
-  p2->raw().elem_len = 0;
-  p2->raw().type = CFI_type_other;
+  a2->raw().elem_len = 0;
+  a2->raw().type = CFI_type_other;
+
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*a1, *a2));
+
+  // CLASS(*), POINTER :: p1
+  auto p1{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4},
+      4, nullptr, 0, nullptr, CFI_attribute_pointer)};
+  p1->raw().elem_len = 0;
+  p1->raw().type = CFI_type_other;
 
-  EXPECT_TRUE(RTNAME(SameTypeAs)(*p1, *p2));
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*i1, *p1));
+  EXPECT_FALSE(RTNAME(SameTypeAs)(*p1, *i1));
 }