[flang-commits] [flang] 7f8da07 - [flang] Refine checks for pointer initialization targets
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Mar 31 11:32:21 PDT 2021
Author: peter klausler
Date: 2021-03-31T11:32:12-07:00
New Revision: 7f8da0791c33a9c87b357859ad84346fe3ccb5f2
URL: https://github.com/llvm/llvm-project/commit/7f8da0791c33a9c87b357859ad84346fe3ccb5f2
DIFF: https://github.com/llvm/llvm-project/commit/7f8da0791c33a9c87b357859ad84346fe3ccb5f2.diff
LOG: [flang] Refine checks for pointer initialization targets
f18 was emitting a bogus error message about the lack of a TARGET
attribute when a pointer was initialized with a component of a
variable that was a legitimate TARGET.
Differential Revision: https://reviews.llvm.org/D99665
Added:
Modified:
flang/include/flang/Evaluate/tools.h
flang/include/flang/Evaluate/traverse.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Semantics/check-data.cpp
flang/test/Semantics/init01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 4a0a4dcf4041e..bcfb1c55e2875 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -730,7 +730,8 @@ common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
// 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<GetLastSymbolHelper, std::optional<const Symbol *>> {
using Result = std::optional<const Symbol *>;
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index c9455910aa411..7a5a4ec9ff873 100644
--- 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 @@ template <typename Visitor, typename Result> class Traverse {
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<semantics::AssocEntityDetails>()}) {
+ 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
index 2e061f0fe3fee..418d161053657 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -39,7 +39,7 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
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 @@ class IsInitialDataTargetHelper
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<semantics::AssocEntityDetails>()}) {
+ 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 @@ class IsInitialDataTargetHelper
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 @@ class IsInitialDataTargetHelper
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 @@ class IsInitialDataTargetHelper
bool operator()(const Relational<SomeType> &) 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 @@ class CheckSpecificationExprHelper
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<semantics::AssocEntityDetails>()}) {
+ 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 @@ class IsSimplyContiguousHelper
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<semantics::ObjectEntityDetails>()}) {
+ ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
// 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
index fccda8ce55a90..7dd0a7a273b9b 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -66,10 +66,11 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
: 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<AssocEntityDetails>() ? "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
index f896943acce18..2492051cdb744 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -82,4 +82,15 @@ subroutine components
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
More information about the flang-commits
mailing list