diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -730,7 +730,8 @@ // GetLastSymbol() returns the rightmost symbol in an object or procedure // designator (which has perhaps been wrapped in an Expr<>), or a null pointer -// when none is found. +// when none is found. It will return an ASSOCIATE construct entity's symbol +// rather than descending into its expression. struct GetLastSymbolHelper : public AnyTraverse> { using Result = std::optional; diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -33,6 +33,9 @@ // subtrees of interior nodes, and the visitor's Combine() to merge their // results together. // - Overloads of operator() in each visitor handle the cases of interest. +// +// The default handler for semantics::Symbol will descend into the associated +// expression of an ASSOCIATE (or related) construct entity. #include "expression.h" #include "flang/Semantics/symbol.h" @@ -102,7 +105,15 @@ return visitor_.Default(); } } - Result operator()(const Symbol &) const { return visitor_.Default(); } + Result operator()(const Symbol &symbol) const { + const Symbol &ultimate{symbol.GetUltimate()}; + if (const auto *assoc{ + ultimate.detailsIf()}) { + return visitor_(assoc->expr()); + } else { + return visitor_.Default(); + } + } Result operator()(const StaticDataObject &) const { return visitor_.Default(); } diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -39,7 +39,7 @@ return semantics::IsKindTypeParameter(inq.parameter()); } bool operator()(const semantics::Symbol &symbol) const { - const auto &ultimate{symbol.GetUltimate()}; + const auto &ultimate{GetAssociationRoot(symbol)}; return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) || IsInitialProcedureTarget(ultimate); } @@ -180,21 +180,19 @@ return false; } bool operator()(const semantics::Symbol &symbol) { + // This function checks only base symbols, not components. const Symbol &ultimate{symbol.GetUltimate()}; - if (IsAllocatable(ultimate)) { - if (messages_) { - messages_->Say( - "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US, - ultimate.name()); - emittedMessage_ = true; - } - return false; - } else if (ultimate.Corank() > 0) { - if (messages_) { - messages_->Say( - "An initial data target may not be a reference to a coarray '%s'"_err_en_US, - ultimate.name()); - emittedMessage_ = true; + if (const auto *assoc{ + ultimate.detailsIf()}) { + if (const auto &expr{assoc->expr()}) { + if (IsVariable(*expr)) { + return (*this)(*expr); + } else if (messages_) { + messages_->Say( + "An initial data target may not be an associated expression ('%s')"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } } return false; } else if (!ultimate.attrs().test(semantics::Attr::TARGET)) { @@ -213,8 +211,9 @@ emittedMessage_ = true; } return false; + } else { + return CheckVarOrComponent(ultimate); } - return true; } bool operator()(const StaticDataObject &) const { return false; } bool operator()(const TypeParamInquiry &) const { return false; } @@ -233,6 +232,9 @@ x.u); } bool operator()(const CoarrayRef &) const { return false; } + bool operator()(const Component &x) { + return CheckVarOrComponent(x.GetLastSymbol()) && (*this)(x.base()); + } bool operator()(const Substring &x) const { return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && (*this)(x.parent()); @@ -258,6 +260,28 @@ bool operator()(const Relational &) const { return false; } private: + bool CheckVarOrComponent(const semantics::Symbol &symbol) { + const Symbol &ultimate{symbol.GetUltimate()}; + if (IsAllocatable(ultimate)) { + if (messages_) { + messages_->Say( + "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } + return false; + } else if (ultimate.Corank() > 0) { + if (messages_) { + messages_->Say( + "An initial data target may not be a reference to a coarray '%s'"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } + return false; + } + return true; + } + parser::ContextualMessages *messages_; bool emittedMessage_{false}; }; @@ -440,8 +464,11 @@ Result operator()(const semantics::Symbol &symbol) const { const auto &ultimate{symbol.GetUltimate()}; - if (semantics::IsNamedConstant(ultimate) || ultimate.owner().IsModule() || - ultimate.owner().IsSubmodule()) { + if (const auto *assoc{ + ultimate.detailsIf()}) { + return (*this)(assoc->expr()); + } else if (semantics::IsNamedConstant(ultimate) || + ultimate.owner().IsModule() || ultimate.owner().IsSubmodule()) { return std::nullopt; } else if (scope_.IsDerivedType() && IsVariableName(ultimate)) { // C750, C754 @@ -584,16 +611,19 @@ using Base::operator(); Result operator()(const semantics::Symbol &symbol) const { - if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) || - symbol.Rank() == 0) { + const auto &ultimate{symbol.GetUltimate()}; + if (ultimate.attrs().test(semantics::Attr::CONTIGUOUS) || + ultimate.Rank() == 0) { return true; - } else if (semantics::IsPointer(symbol)) { + } else if (semantics::IsPointer(ultimate)) { return false; } else if (const auto *details{ - symbol.detailsIf()}) { + ultimate.detailsIf()}) { // N.B. ALLOCATABLEs are deferred shape, not assumed, and // are obviously contiguous. return !details->IsAssumedShape() && !details->IsAssumedRank(); + } else if (auto assoc{Base::operator()(ultimate)}) { + return assoc; } else { return false; } diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -66,10 +66,11 @@ : IsInBlankCommon(symbol) ? "Blank COMMON object" : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure" // remaining checks don't apply to components - : !isFirstSymbol ? nullptr - : IsHostAssociated(symbol, scope) ? "Host-associated object" - : IsUseAssociated(symbol, scope) ? "USE-associated object" - : nullptr}) { + : !isFirstSymbol ? nullptr + : IsHostAssociated(symbol, scope) ? "Host-associated object" + : IsUseAssociated(symbol, scope) ? "USE-associated object" + : symbol.has() ? "Construct association" + : nullptr}) { context_.Say(source_, "%s '%s' must not be initialized in a DATA statement"_err_en_US, whyNot, symbol.name()); diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90 --- a/flang/test/Semantics/init01.f90 +++ b/flang/test/Semantics/init01.f90 @@ -82,4 +82,15 @@ end type type(t2(3,3)) :: o1 type(t2(2,2)) :: o2 + type :: t3 + real :: x + end type + type(t3), save, target :: o3 + real, pointer :: p10 => o3%x + associate (a1 => o3, a2 => o3%x) + block + real, pointer :: p11 => a1 + real, pointer :: p12 => a2 + end block + end associate end subroutine