From 188c02daaa24a484507a5e20db475180e793ccfd Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Thu, 9 Mar 2023 15:46:59 +0100 Subject: [PATCH] [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 --- flang/runtime/derived-api.cpp | 9 +++------ flang/unittests/Runtime/Derived.cpp | 33 +++++++++++++++++++++------------ 2 files changed, 24 insertions(+), 18 deletions(-) diff --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp index 4cceace..8f66a8e 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 7e54367..89306c8 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)); } -- 2.7.4