[flang-commits] [flang] 25822dc - [flang] Fix searches for polymorphic components (#102212)
via flang-commits
flang-commits at lists.llvm.org
Thu Aug 8 11:07:44 PDT 2024
Author: Peter Klausler
Date: 2024-08-08T11:07:40-07:00
New Revision: 25822dc392dcb8e15f6b24feecce06f28d07b8ad
URL: https://github.com/llvm/llvm-project/commit/25822dc392dcb8e15f6b24feecce06f28d07b8ad
DIFF: https://github.com/llvm/llvm-project/commit/25822dc392dcb8e15f6b24feecce06f28d07b8ad.diff
LOG: [flang] Fix searches for polymorphic components (#102212)
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.
Added:
flang/test/Semantics/typeinfo11.f90
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/definable.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/call10.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index ec275f349e81bf..15c02ecc0058cc 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 be0de5b4e03a42..de3fa8794caedf 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -405,9 +405,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 ae76f668f6ce7b..62fed63df4475c 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 fdaf052c2d34eb..57d84bde60b43c 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 ffb3b48c329e72..2d2f57934cd8aa 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 00000000000000..92efc8f9ea54b8
--- /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)
More information about the flang-commits
mailing list