From 962863d988195917b7d2ccfb83a3a166e01ffc77 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Thu, 17 Nov 2022 16:30:49 -0800 Subject: [PATCH] [flang] Catch attempts to copy pointers in allocatables in PURE In a pure context, a pointer acquired from an INTENT(IN) dummy argument may not be copied. Catch the case in which the pointer is a component of an allocatable component at some depth of nesting. (This patch adds a new component iterator kind that is a variant of a potential subobject component iterator; it visits all potential subobject components, plus pointers, into which it does not descend.) Differential Revision: https://reviews.llvm.org/D139161 --- flang/include/flang/Semantics/tools.h | 10 +++++++++- flang/lib/Semantics/assignment.cpp | 6 +++--- flang/lib/Semantics/tools.cpp | 34 ++++++---------------------------- flang/test/Semantics/call12.f90 | 16 +++++++++++++--- 4 files changed, 31 insertions(+), 35 deletions(-) diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index da5c936..4703f25 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -383,6 +383,10 @@ std::list> GetStorageAssociations(const Scope &); // its non-POINTER components and the potential subobject components of // its non-POINTER derived type components. (The lifetime of each // potential subobject component is that of the entire instance.) +// - PotentialAndPointer subobject components of a derived type are the +// closure of +// its components (including POINTERs) and the PotentialAndPointer subobject +// components of its non-POINTER derived type components. // Parent and procedure components are considered against these definitions. // For this kind of iterator, the component tree is recursively visited in the // following order: @@ -413,7 +417,8 @@ std::list> GetStorageAssociations(const Scope &); // .... // } -ENUM_CLASS(ComponentKind, Ordered, Direct, Ultimate, Potential, Scope) +ENUM_CLASS(ComponentKind, Ordered, Direct, Ultimate, Potential, Scope, + PotentialAndPointer) template class ComponentIterator { public: @@ -535,11 +540,14 @@ extern template class ComponentIterator; extern template class ComponentIterator; extern template class ComponentIterator; extern template class ComponentIterator; +extern template class ComponentIterator; using OrderedComponentIterator = ComponentIterator; using DirectComponentIterator = ComponentIterator; using UltimateComponentIterator = ComponentIterator; using PotentialComponentIterator = ComponentIterator; using ScopeComponentIterator = ComponentIterator; +using PotentialAndPointerComponentIterator = + ComponentIterator; // Common component searches, the iterator returned is referring to the first // component, according to the order defined for the related ComponentIterator, diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp index 8df6991..3c3f263 100644 --- a/flang/lib/Semantics/assignment.cpp +++ b/flang/lib/Semantics/assignment.cpp @@ -98,9 +98,9 @@ static std::optional GetPointerComponentDesignatorName( const SomeExpr &expr) { if (const auto *derived{ evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) { - UltimateComponentIterator ultimates{*derived}; + PotentialAndPointerComponentIterator potentials{*derived}; if (auto pointer{ - std::find_if(ultimates.begin(), ultimates.end(), IsPointer)}) { + std::find_if(potentials.begin(), potentials.end(), IsPointer)}) { return pointer.BuildResultDesignatorName(); } } @@ -116,7 +116,7 @@ bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages, if (auto pointer{GetPointerComponentDesignatorName(expr)}) { evaluate::SayWithDeclaration(messages, *base, "A pure subprogram may not copy the value of '%s' because it is %s" - " and has the POINTER component '%s'"_err_en_US, + " and has the POINTER potential subobject component '%s'"_err_en_US, base->name(), why, *pointer); return false; } diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 20c87ae..c3c40ec 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -806,34 +806,6 @@ bool IsModuleProcedure(const Symbol &symbol) { return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module; } -PotentialComponentIterator::const_iterator FindPolymorphicPotentialComponent( - const DerivedTypeSpec &derived) { - PotentialComponentIterator potentials{derived}; - return std::find_if( - potentials.begin(), potentials.end(), [](const Symbol &component) { - if (const auto *details{component.detailsIf()}) { - const DeclTypeSpec *type{details->type()}; - return type && type->IsPolymorphic(); - } - return false; - }); -} - -bool IsOrContainsPolymorphicComponent(const Symbol &original) { - const Symbol &symbol{ResolveAssociations(original)}; - if (const auto *details{symbol.detailsIf()}) { - if (const DeclTypeSpec * type{details->type()}) { - if (type->IsPolymorphic()) { - return true; - } - if (const DerivedTypeSpec * derived{type->AsDerived()}) { - return (bool)FindPolymorphicPotentialComponent(*derived); - } - } - } - return false; -} - class ImageControlStmtHelper { using ImageControlStmts = std::variant::const_iterator::PlanComponentTraversal( traverse = !IsPointer(component); } else if constexpr (componentKind == ComponentKind::Scope) { traverse = !IsAllocatableOrPointer(component); + } else if constexpr (componentKind == + ComponentKind::PotentialAndPointer) { + traverse = !IsPointer(component); } if (traverse) { const Symbol &newTypeSymbol{derived->typeSymbol()}; @@ -1165,6 +1140,8 @@ static bool StopAtComponentPre(const Symbol &component) { component.get().type()->AsIntrinsic()); } else if constexpr (componentKind == ComponentKind::Potential) { return !IsPointer(component); + } else if constexpr (componentKind == ComponentKind::PotentialAndPointer) { + return true; } } @@ -1233,6 +1210,7 @@ template class ComponentIterator; template class ComponentIterator; template class ComponentIterator; template class ComponentIterator; +template class ComponentIterator; UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent( const DerivedTypeSpec &derived) { diff --git a/flang/test/Semantics/call12.f90 b/flang/test/Semantics/call12.f90 index 8ba42c1..2e5591a 100644 --- a/flang/test/Semantics/call12.f90 +++ b/flang/test/Semantics/call12.f90 @@ -17,6 +17,9 @@ module m type :: hasCoarray real, allocatable :: co[:] end type + type :: hasHiddenPtr + type(hasPtr), allocatable :: a + end type contains integer pure function purefunc(x) integer, intent(in) :: x @@ -26,14 +29,17 @@ module m procedure(purefunc) :: p0 f00 = p0(1) end function - pure function test(ptr, in, hpd) + pure function test(ptr, in, hpd, hhpd) use used type(t), pointer :: ptr, ptr2 type(t), target, intent(in) :: in type(t), target :: y, z type(hasPtr) :: hp type(hasPtr), intent(in) :: hpd + type(hasHiddenPtr) :: hhp + type(hasHiddenPtr), intent(in) :: hhpd type(hasPtr), allocatable :: alloc + type(hasHiddenPtr), allocatable :: hpAlloc type(hasCoarray), pointer :: hcp integer :: n common /block/ y @@ -76,10 +82,14 @@ module m n = size([hasPtr(ptr%a)]) ! C1594(4) !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure n = size([hasPtr(in%a)]) ! C1594(4) - !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p' + !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p' hp = hpd ! C1594(5) - !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p' + !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p' allocate(alloc, source=hpd) + !ERROR: A pure subprogram may not copy the value of 'hhpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%a%p' + hhp = hhpd + !ERROR: A pure subprogram may not copy the value of 'hhpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%a%p' + allocate(hpAlloc, source=hhpd) !ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface n = f00(extfunc) contains -- 2.7.4