// 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:
// ....
// }
-ENUM_CLASS(ComponentKind, Ordered, Direct, Ultimate, Potential, Scope)
+ENUM_CLASS(ComponentKind, Ordered, Direct, Ultimate, Potential, Scope,
+ PotentialAndPointer)
template <ComponentKind componentKind> class ComponentIterator {
public:
extern template class ComponentIterator<ComponentKind::Ultimate>;
extern template class ComponentIterator<ComponentKind::Potential>;
extern template class ComponentIterator<ComponentKind::Scope>;
+extern template class ComponentIterator<ComponentKind::PotentialAndPointer>;
using OrderedComponentIterator = ComponentIterator<ComponentKind::Ordered>;
using DirectComponentIterator = ComponentIterator<ComponentKind::Direct>;
using UltimateComponentIterator = ComponentIterator<ComponentKind::Ultimate>;
using PotentialComponentIterator = ComponentIterator<ComponentKind::Potential>;
using ScopeComponentIterator = ComponentIterator<ComponentKind::Scope>;
+using PotentialAndPointerComponentIterator =
+ ComponentIterator<ComponentKind::PotentialAndPointer>;
// Common component searches, the iterator returned is referring to the first
// component, according to the order defined for the related ComponentIterator,
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();
}
}
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;
}
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<ObjectEntityDetails>()}) {
- 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<ObjectEntityDetails>()}) {
- 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<parser::ChangeTeamConstruct, parser::CriticalConstruct,
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()};
component.get<ObjectEntityDetails>().type()->AsIntrinsic());
} else if constexpr (componentKind == ComponentKind::Potential) {
return !IsPointer(component);
+ } else if constexpr (componentKind == ComponentKind::PotentialAndPointer) {
+ return true;
}
}
template class ComponentIterator<ComponentKind::Ultimate>;
template class ComponentIterator<ComponentKind::Potential>;
template class ComponentIterator<ComponentKind::Scope>;
+template class ComponentIterator<ComponentKind::PotentialAndPointer>;
UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &derived) {
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
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
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