[flang-commits] [flang] [flang] Fix searches for polymorphic components (PR #102212)
via flang-commits
flang-commits at lists.llvm.org
Tue Aug 6 13:16:31 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
FindPolymorphicAllocatableUltimateComponent needs to be FindPolymorphicAllocatablePotentialComponent. The current search is missing cases where a derived type has an allocatable component whose type has a polymorphic allocatable component.
---
Full diff: https://github.com/llvm/llvm-project/pull/102212.diff
6 Files Affected:
- (modified) flang/include/flang/Semantics/tools.h (+14-2)
- (modified) flang/lib/Semantics/check-declarations.cpp (+3-2)
- (modified) flang/lib/Semantics/definable.cpp (+2-1)
- (modified) flang/lib/Semantics/tools.cpp (+5-5)
- (modified) flang/test/Semantics/call10.f90 (+1-1)
- (added) flang/test/Semantics/typeinfo11.f90 (+17)
``````````diff
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index ec275f349e81b..15c02ecc0058c 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -442,6 +442,18 @@ std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &);
// closure of its components (including POINTERs) and the
// PotentialAndPointer subobject components of its non-POINTER derived type
// components.
+//
+// type t1 ultimate components: x, a, p
+// real x direct components: x, a, p
+// real, allocatable :: a potential components: x, a
+// real, pointer :: p potential & pointers: x, a, p
+// end type
+// type t2 ultimate components: y, c%x, c%a, c%p, b
+// real y direct components: y, c, c%x, c%a, c%p, b
+// type(t1) :: c potential components: y, c, c%x, c%a, b, b%x, b%a
+// type(t1), allocatable :: b potential & pointers: potentials + c%p + b%p
+// end type
+//
// Parent and procedure components are considered against these definitions.
// For this kind of iterator, the component tree is recursively visited in the
// following order:
@@ -620,8 +632,8 @@ UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
const DerivedTypeSpec &);
DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
const DerivedTypeSpec &);
-UltimateComponentIterator::const_iterator
-FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &);
+PotentialComponentIterator::const_iterator
+FindPolymorphicAllocatablePotentialComponent(const DerivedTypeSpec &);
// The LabelEnforce class (given a set of labels) provides an error message if
// there is a branch to a label which is not in the given set.
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index a52f013a70b9d..d4dee388586d6 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -397,9 +397,10 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"Result of pure function may not have an impure FINAL subroutine"_err_en_US);
}
- if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
+ if (auto bad{
+ FindPolymorphicAllocatablePotentialComponent(*derived)}) {
SayWithDeclaration(*bad,
- "Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
+ "Result of pure function may not have polymorphic ALLOCATABLE potential component '%s'"_err_en_US,
bad.BuildResultDesignatorName());
}
}
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index ae76f668f6ce7..62fed63df4475 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -223,7 +223,8 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
}
if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
- if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
+ if (auto bad{
+ FindPolymorphicAllocatablePotentialComponent(*derived)}) {
return BlameSymbol(at,
"'%s' has polymorphic component '%s' in a pure subprogram"_en_US,
original, bad.BuildResultDesignatorName());
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index fdaf052c2d34e..57d84bde60b43 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -866,7 +866,7 @@ const Symbol *HasImpureFinal(const Symbol &original, std::optional<int> rank) {
bool MayRequireFinalization(const DerivedTypeSpec &derived) {
return IsFinalizable(derived) ||
- FindPolymorphicAllocatableUltimateComponent(derived);
+ FindPolymorphicAllocatablePotentialComponent(derived);
}
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
@@ -1404,11 +1404,11 @@ DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
return std::find_if(directs.begin(), directs.end(), IsAllocatableOrPointer);
}
-UltimateComponentIterator::const_iterator
-FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &derived) {
- UltimateComponentIterator ultimates{derived};
+PotentialComponentIterator::const_iterator
+FindPolymorphicAllocatablePotentialComponent(const DerivedTypeSpec &derived) {
+ PotentialComponentIterator potentials{derived};
return std::find_if(
- ultimates.begin(), ultimates.end(), IsPolymorphicAllocatable);
+ potentials.begin(), potentials.end(), IsPolymorphicAllocatable);
}
const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90
index ffb3b48c329e7..2d2f57934cd8a 100644
--- a/flang/test/Semantics/call10.f90
+++ b/flang/test/Semantics/call10.f90
@@ -78,7 +78,7 @@ pure function f07() ! C1585
class(t), allocatable :: f07
end function
pure function f08() ! C1585
- !ERROR: Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%a'
+ !ERROR: Result of pure function may not have polymorphic ALLOCATABLE potential component '%a'
type(polyAlloc) :: f08
end function
diff --git a/flang/test/Semantics/typeinfo11.f90 b/flang/test/Semantics/typeinfo11.f90
new file mode 100644
index 0000000000000..92efc8f9ea54b
--- /dev/null
+++ b/flang/test/Semantics/typeinfo11.f90
@@ -0,0 +1,17 @@
+!RUN: bbc --dump-symbols %s | FileCheck %s
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+
+!Tests that derived types with polymorphic potential subobject
+!components do not have their noFinalizationNeeded flags set, even
+!when those components are packaged within another allocatable.
+
+type t1
+ class(*), allocatable :: a
+end type
+type t2
+ type(t1), allocatable :: b
+end type
+type(t2) x
+end
+
+!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
``````````
</details>
https://github.com/llvm/llvm-project/pull/102212
More information about the flang-commits
mailing list