From de9db9df1b319d3a617523e03d0c62ba9143e638 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Mon, 29 Sep 2025 17:17:56 -0700 Subject: [PATCH 1/7] initial commit --- .../include/flang-rt/runtime/descriptor.h | 3 ++ flang-rt/lib/runtime/derived-api.cpp | 48 ++++++++++++------- flang-rt/lib/runtime/pointer.cpp | 2 +- 3 files changed, 35 insertions(+), 18 deletions(-) diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h index ff7ec050d32c7..d34eb326d39b7 100644 --- a/flang-rt/include/flang-rt/runtime/descriptor.h +++ b/flang-rt/include/flang-rt/runtime/descriptor.h @@ -227,6 +227,9 @@ class Descriptor { RT_API_ATTRS bool IsPointer() const { return raw_.attribute == CFI_attribute_pointer; } + RT_API_ATTRS bool IsAssociated() const { + return raw_.base_addr != nullptr; + } RT_API_ATTRS bool IsAllocatable() const { return raw_.attribute == CFI_attribute_allocatable; } diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index bb08e0397fe9c..31b5333eace2f 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -118,29 +118,43 @@ bool RTDEF(SameTypeAs)(const Descriptor &a, const Descriptor &b) { } bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { + // The wording of the standard indicates the order in which each case + // is checked. If performance becomes an issue, there are less maintainable + // versions of this code that would probably execute faster. + // F'23 16.9.86 p 5 + // If MOLD is unlimited polymorphic and is either a disassociated pointer or + // unallocated allocatable variable, the result is true; + if ((mold.IsPointer() && !mold.IsAssociated()) || + (mold.IsAllocatable() && !mold.IsAllocated())) { + return true; + } else if ((a.IsPointer() && !mold.IsAssociated()) || + (a.IsAllocatable() && !a.IsAllocated())) { + return false; + } auto aType{a.raw().type}; auto moldType{mold.raw().type}; - if ((aType != CFI_type_struct && aType != CFI_type_other) || - (moldType != CFI_type_struct && moldType != CFI_type_other)) { - // If either type is intrinsic, they must match. - return aType == moldType; - } else if (const typeInfo::DerivedType * - derivedTypeMold{GetDerivedType(mold)}) { - // If A is unlimited polymorphic and is either a disassociated pointer or - // unallocated allocatable, the result is false. - // Otherwise if the dynamic type of A or MOLD is extensible, the result is - // true if and only if the dynamic type of A is an extension type of the - // dynamic type of MOLD. - for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; - derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { - if (derivedTypeA == derivedTypeMold) { - return true; + if (aType == CFI_type_struct && moldType == CFI_type_struct) { + if (const auto *derivedTypeMold{GetDerivedType(mold)}) { + // Otherwise if the dynamic type of A or MOLD is extensible, the result is + // true if and only if the dynamic type of A is an extension type of the + // dynamic type of MOLD. + for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; + derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { + if (derivedTypeA == derivedTypeMold) { + return true; + } } + return false; } - return false; - } else { // MOLD is unlimited polymorphic and unallocated/disassociated. + // This might be impossible to reach since the case is now handled explicitly + // above. return true; + } else { + // F'23: otherwise, the result is processor dependent. + // extension, if types are not extensible, true if they match. + return aType != CFI_type_other && moldType != CFI_type_other && + aType == moldType; } } diff --git a/flang-rt/lib/runtime/pointer.cpp b/flang-rt/lib/runtime/pointer.cpp index f8ada65541a1a..df72c052eaf93 100644 --- a/flang-rt/lib/runtime/pointer.cpp +++ b/flang-rt/lib/runtime/pointer.cpp @@ -259,7 +259,7 @@ int RTDEF(PointerDeallocatePolymorphic)(Descriptor &pointer, } bool RTDEF(PointerIsAssociated)(const Descriptor &pointer) { - return pointer.raw().base_addr != nullptr; + return pointer.IsAssociated(); } bool RTDEF(PointerIsAssociatedWith)( From 05a86992ae61e4da6090b4f6989a01a91bb42cf4 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Tue, 30 Sep 2025 17:49:54 -0700 Subject: [PATCH 2/7] run clang format --- flang-rt/include/flang-rt/runtime/descriptor.h | 4 +--- flang-rt/lib/runtime/derived-api.cpp | 18 +++++++++--------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h index d34eb326d39b7..d1a0eaaad7a3d 100644 --- a/flang-rt/include/flang-rt/runtime/descriptor.h +++ b/flang-rt/include/flang-rt/runtime/descriptor.h @@ -227,9 +227,7 @@ class Descriptor { RT_API_ATTRS bool IsPointer() const { return raw_.attribute == CFI_attribute_pointer; } - RT_API_ATTRS bool IsAssociated() const { - return raw_.base_addr != nullptr; - } + RT_API_ATTRS bool IsAssociated() const { return raw_.base_addr != nullptr; } RT_API_ATTRS bool IsAllocatable() const { return raw_.attribute == CFI_attribute_allocatable; } diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index 31b5333eace2f..bca4fe76c1864 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -124,7 +124,7 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { // F'23 16.9.86 p 5 // If MOLD is unlimited polymorphic and is either a disassociated pointer or // unallocated allocatable variable, the result is true; - if ((mold.IsPointer() && !mold.IsAssociated()) || + if ((mold.IsPointer() && !mold.IsAssociated()) || (mold.IsAllocatable() && !mold.IsAllocated())) { return true; } else if ((a.IsPointer() && !mold.IsAssociated()) || @@ -139,22 +139,22 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { // true if and only if the dynamic type of A is an extension type of the // dynamic type of MOLD. for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; - derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { - if (derivedTypeA == derivedTypeMold) { - return true; - } + derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { + if (derivedTypeA == derivedTypeMold) { + return true; + } } return false; } // MOLD is unlimited polymorphic and unallocated/disassociated. - // This might be impossible to reach since the case is now handled explicitly - // above. + // This might be impossible to reach since the case is now handled + // explicitly above. return true; } else { // F'23: otherwise, the result is processor dependent. // extension, if types are not extensible, true if they match. - return aType != CFI_type_other && moldType != CFI_type_other && - aType == moldType; + return aType != CFI_type_other && moldType != CFI_type_other && + aType == moldType; } } From f360deca5b549ac0249e00cb56e5100f05016c2f Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 1 Oct 2025 10:29:25 -0700 Subject: [PATCH 3/7] fixing typo in pointer check of object --- flang-rt/lib/runtime/derived-api.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index bca4fe76c1864..d531822abb9dd 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -127,7 +127,7 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { if ((mold.IsPointer() && !mold.IsAssociated()) || (mold.IsAllocatable() && !mold.IsAllocated())) { return true; - } else if ((a.IsPointer() && !mold.IsAssociated()) || + } else if ((a.IsPointer() && !a.IsAssociated()) || (a.IsAllocatable() && !a.IsAllocated())) { return false; } From d61ea033e5162d52a81f5d7a95f981906d018109 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 1 Oct 2025 13:10:10 -0700 Subject: [PATCH 4/7] address feedback --- flang-rt/include/flang-rt/runtime/descriptor.h | 1 - flang-rt/lib/runtime/derived-api.cpp | 6 ++---- flang-rt/lib/runtime/pointer.cpp | 2 +- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h index d1a0eaaad7a3d..ff7ec050d32c7 100644 --- a/flang-rt/include/flang-rt/runtime/descriptor.h +++ b/flang-rt/include/flang-rt/runtime/descriptor.h @@ -227,7 +227,6 @@ class Descriptor { RT_API_ATTRS bool IsPointer() const { return raw_.attribute == CFI_attribute_pointer; } - RT_API_ATTRS bool IsAssociated() const { return raw_.base_addr != nullptr; } RT_API_ATTRS bool IsAllocatable() const { return raw_.attribute == CFI_attribute_allocatable; } diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index d531822abb9dd..62be78a9449d8 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -124,11 +124,9 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { // F'23 16.9.86 p 5 // If MOLD is unlimited polymorphic and is either a disassociated pointer or // unallocated allocatable variable, the result is true; - if ((mold.IsPointer() && !mold.IsAssociated()) || - (mold.IsAllocatable() && !mold.IsAllocated())) { + if ((mold.IsPointer() || mold.IsAllocatable()) && !mold.IsAllocated()) { return true; - } else if ((a.IsPointer() && !a.IsAssociated()) || - (a.IsAllocatable() && !a.IsAllocated())) { + } else if ((a.IsPointer() || a.IsAllocatable()) && !a.IsAllocated()) { return false; } auto aType{a.raw().type}; diff --git a/flang-rt/lib/runtime/pointer.cpp b/flang-rt/lib/runtime/pointer.cpp index df72c052eaf93..f8ada65541a1a 100644 --- a/flang-rt/lib/runtime/pointer.cpp +++ b/flang-rt/lib/runtime/pointer.cpp @@ -259,7 +259,7 @@ int RTDEF(PointerDeallocatePolymorphic)(Descriptor &pointer, } bool RTDEF(PointerIsAssociated)(const Descriptor &pointer) { - return pointer.IsAssociated(); + return pointer.raw().base_addr != nullptr; } bool RTDEF(PointerIsAssociatedWith)( From 9ff552644c3bf72356035e0633cf4812b1fe4eca Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 1 Oct 2025 13:51:14 -0700 Subject: [PATCH 5/7] simplifying further --- flang-rt/lib/runtime/derived-api.cpp | 50 +++++++++++++--------------- 1 file changed, 24 insertions(+), 26 deletions(-) diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index 62be78a9449d8..e25288ab197d6 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -118,41 +118,39 @@ bool RTDEF(SameTypeAs)(const Descriptor &a, const Descriptor &b) { } bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { - // The wording of the standard indicates the order in which each case - // is checked. If performance becomes an issue, there are less maintainable - // versions of this code that would probably execute faster. + // The wording of the standard indicates null or unallocated checks take + // precedence over the extension checks which take precedence over any + // compiler specific behavior. // F'23 16.9.86 p 5 // If MOLD is unlimited polymorphic and is either a disassociated pointer or // unallocated allocatable variable, the result is true; - if ((mold.IsPointer() || mold.IsAllocatable()) && !mold.IsAllocated()) { - return true; - } else if ((a.IsPointer() || a.IsAllocatable()) && !a.IsAllocated()) { - return false; - } auto aType{a.raw().type}; auto moldType{mold.raw().type}; - if (aType == CFI_type_struct && moldType == CFI_type_struct) { - if (const auto *derivedTypeMold{GetDerivedType(mold)}) { - // Otherwise if the dynamic type of A or MOLD is extensible, the result is - // true if and only if the dynamic type of A is an extension type of the - // dynamic type of MOLD. - for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; - derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { - if (derivedTypeA == derivedTypeMold) { - return true; - } - } + if ((aType != CFI_type_struct && aType != CFI_type_other) || + (moldType != CFI_type_struct && moldType != CFI_type_other)) { + if (!mold.IsAllocated()) { + return true; + } else if (!a.IsAllocated()) { return false; + } else { + // If either type is intrinsic and not a pointer or allocatable + // then they must match. + return aType == moldType; } + } else if (const auto *derivedTypeMold{GetDerivedType(mold)}) { + // Otherwise if the dynamic type of A or MOLD is extensible, the result is + // true if and only if the dynamic type of A is an extension type of the + // dynamic type of MOLD. + for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; + derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { + if (derivedTypeA == derivedTypeMold) { + return true; + } + } + return false; + } else { // MOLD is unlimited polymorphic and unallocated/disassociated. - // This might be impossible to reach since the case is now handled - // explicitly above. return true; - } else { - // F'23: otherwise, the result is processor dependent. - // extension, if types are not extensible, true if they match. - return aType != CFI_type_other && moldType != CFI_type_other && - aType == moldType; } } From 59f8e3f9d72cc6d2847491c19a148b2de19101de Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 1 Oct 2025 14:00:37 -0700 Subject: [PATCH 6/7] fix spacing --- flang-rt/lib/runtime/derived-api.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index e25288ab197d6..b519a309eb06d 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -142,7 +142,7 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { // true if and only if the dynamic type of A is an extension type of the // dynamic type of MOLD. for (const typeInfo::DerivedType *derivedTypeA{GetDerivedType(a)}; - derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { + derivedTypeA; derivedTypeA = derivedTypeA->GetParentType()) { if (derivedTypeA == derivedTypeMold) { return true; } From 69e907a13b4a331b8fdd65f7db9044a528eaf4d5 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 1 Oct 2025 14:10:15 -0700 Subject: [PATCH 7/7] add comment back --- flang-rt/lib/runtime/derived-api.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/flang-rt/lib/runtime/derived-api.cpp b/flang-rt/lib/runtime/derived-api.cpp index b519a309eb06d..fe6868292f019 100644 --- a/flang-rt/lib/runtime/derived-api.cpp +++ b/flang-rt/lib/runtime/derived-api.cpp @@ -138,6 +138,8 @@ bool RTDEF(ExtendsTypeOf)(const Descriptor &a, const Descriptor &mold) { return aType == moldType; } } else if (const auto *derivedTypeMold{GetDerivedType(mold)}) { + // If A is unlimited polymorphic and is either a disassociated pointer or + // unallocated allocatable, the result is false. // Otherwise if the dynamic type of A or MOLD is extensible, the result is // true if and only if the dynamic type of A is an extension type of the // dynamic type of MOLD.