[flang-commits] [flang] d742c2a - [flang] Move EQUIVALENCE object checking to check-declarations.cpp (#91259)
via flang-commits
flang-commits at lists.llvm.org
Thu May 9 10:53:33 PDT 2024
Author: Peter Klausler
Date: 2024-05-09T10:53:29-07:00
New Revision: d742c2aa25226c2b48f3917ed86a5a224cf25734
URL: https://github.com/llvm/llvm-project/commit/d742c2aa25226c2b48f3917ed86a5a224cf25734
DIFF: https://github.com/llvm/llvm-project/commit/d742c2aa25226c2b48f3917ed86a5a224cf25734.diff
LOG: [flang] Move EQUIVALENCE object checking to check-declarations.cpp (#91259)
Move EQUIVALENCE object checking from resolve-names-utils.cpp to
check-declarations.cpp, where it can work on fully resolved symbols and
reduce clutter in name resolution. Add a check for EQUIVALENCE objects
that are not ObjectEntityDetails symbols so that attempts to equivalence
a procedure are caught.
Added:
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/test/Semantics/equivalence01.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index c1d9538e557f5..f57020bbe7072 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -87,6 +87,7 @@ class CheckHelper {
bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int);
void CheckSpecifics(const Symbol &, const GenericDetails &);
void CheckEquivalenceSet(const EquivalenceSet &);
+ void CheckEquivalenceObject(const EquivalenceObject &);
void CheckBlockData(const Scope &);
void CheckGenericOps(const Scope &);
bool CheckConflicting(const Symbol &, Attr, Attr);
@@ -2558,14 +2559,77 @@ void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) {
}
}
}
- // TODO: Move C8106 (&al.) checks here from resolve-names-utils.cpp
for (const EquivalenceObject &object : set) {
- if (object.symbol.test(Symbol::Flag::CrayPointee)) {
+ CheckEquivalenceObject(object);
+ }
+}
+
+static bool InCommonWithBind(const Symbol &symbol) {
+ if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
+ const Symbol *commonBlock{details->commonBlock()};
+ return commonBlock && commonBlock->attrs().test(Attr::BIND_C);
+ } else {
+ return false;
+ }
+}
+
+void CheckHelper::CheckEquivalenceObject(const EquivalenceObject &object) {
+ parser::MessageFixedText msg;
+ const Symbol &symbol{object.symbol};
+ if (symbol.owner().IsDerivedType()) {
+ msg =
+ "Derived type component '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (IsDummy(symbol)) {
+ msg = "Dummy argument '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.IsFuncResult()) {
+ msg = "Function result '%s' is not allow in an equivalence set"_err_en_US;
+ } else if (IsPointer(symbol)) {
+ msg = "Pointer '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (IsAllocatable(symbol)) {
+ msg =
+ "Allocatable variable '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.Corank() > 0) {
+ msg = "Coarray '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.has<UseDetails>()) {
+ msg =
+ "Use-associated variable '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.attrs().test(Attr::BIND_C)) {
+ msg =
+ "Variable '%s' with BIND attribute is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.attrs().test(Attr::TARGET)) {
+ msg =
+ "Variable '%s' with TARGET attribute is not allowed in an equivalence set"_err_en_US;
+ } else if (IsNamedConstant(symbol)) {
+ msg = "Named constant '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (InCommonWithBind(symbol)) {
+ msg =
+ "Variable '%s' in common block with BIND attribute is not allowed in an equivalence set"_err_en_US;
+ } else if (!symbol.has<ObjectEntityDetails>()) {
+ msg = "'%s' in equivalence set is not a data object"_err_en_US;
+ } else if (const auto *type{symbol.GetType()}) {
+ const auto *derived{type->AsDerived()};
+ if (derived && !derived->IsVectorType()) {
+ if (const auto *comp{
+ FindUltimateComponent(*derived, IsAllocatableOrPointer)}) {
+ msg = IsPointer(*comp)
+ ? "Derived type object '%s' with pointer ultimate component is not allowed in an equivalence set"_err_en_US
+ : "Derived type object '%s' with allocatable ultimate component is not allowed in an equivalence set"_err_en_US;
+ } else if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
+ msg =
+ "Nonsequence derived type object '%s' is not allowed in an equivalence set"_err_en_US;
+ }
+ } else if (IsAutomatic(symbol)) {
+ msg =
+ "Automatic object '%s' is not allowed in an equivalence set"_err_en_US;
+ } else if (symbol.test(Symbol::Flag::CrayPointee)) {
messages_.Say(object.symbol.name(),
"Cray pointee '%s' may not be a member of an EQUIVALENCE group"_err_en_US,
object.symbol.name());
}
}
+ if (!msg.text().empty()) {
+ context_.Say(object.source, std::move(msg), symbol.name());
+ }
}
void CheckHelper::CheckBlockData(const Scope &scope) {
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 2eb3a34ad8065..d9a9576e9d676 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -277,20 +277,22 @@ std::size_t ComputeOffsetsHelper::ComputeOffset(
const EquivalenceObject &object) {
std::size_t offset{0};
if (!object.subscripts.empty()) {
- const ArraySpec &shape{object.symbol.get<ObjectEntityDetails>().shape()};
- auto lbound{[&](std::size_t i) {
- return *ToInt64(shape[i].lbound().GetExplicit());
- }};
- auto ubound{[&](std::size_t i) {
- return *ToInt64(shape[i].ubound().GetExplicit());
- }};
- for (std::size_t i{object.subscripts.size() - 1};;) {
- offset += object.subscripts[i] - lbound(i);
- if (i == 0) {
- break;
+ if (const auto *details{object.symbol.detailsIf<ObjectEntityDetails>()}) {
+ const ArraySpec &shape{details->shape()};
+ auto lbound{[&](std::size_t i) {
+ return *ToInt64(shape[i].lbound().GetExplicit());
+ }};
+ auto ubound{[&](std::size_t i) {
+ return *ToInt64(shape[i].ubound().GetExplicit());
+ }};
+ for (std::size_t i{object.subscripts.size() - 1};;) {
+ offset += object.subscripts[i] - lbound(i);
+ if (i == 0) {
+ break;
+ }
+ --i;
+ offset *= ubound(i) - lbound(i) + 1;
}
- --i;
- offset *= ubound(i) - lbound(i) + 1;
}
}
auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 801473876e7e2..3ca460b8e46ac 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -568,75 +568,9 @@ bool EquivalenceSets::CheckDataRef(
x.u);
}
-static bool InCommonWithBind(const Symbol &symbol) {
- if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
- const Symbol *commonBlock{details->commonBlock()};
- return commonBlock && commonBlock->attrs().test(Attr::BIND_C);
- } else {
- return false;
- }
-}
-
-// If symbol can't be in equivalence set report error and return false;
bool EquivalenceSets::CheckObject(const parser::Name &name) {
- if (!name.symbol) {
- return false; // an error has already occurred
- }
currObject_.symbol = name.symbol;
- parser::MessageFixedText msg;
- const Symbol &symbol{*name.symbol};
- if (symbol.owner().IsDerivedType()) { // C8107
- msg = "Derived type component '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (IsDummy(symbol)) { // C8106
- msg = "Dummy argument '%s' is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.IsFuncResult()) { // C8106
- msg = "Function result '%s' is not allow in an equivalence set"_err_en_US;
- } else if (IsPointer(symbol)) { // C8106
- msg = "Pointer '%s' is not allowed in an equivalence set"_err_en_US;
- } else if (IsAllocatable(symbol)) { // C8106
- msg = "Allocatable variable '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.Corank() > 0) { // C8106
- msg = "Coarray '%s' is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.has<UseDetails>()) { // C8115
- msg = "Use-associated variable '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.attrs().test(Attr::BIND_C)) { // C8106
- msg = "Variable '%s' with BIND attribute"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (symbol.attrs().test(Attr::TARGET)) { // C8108
- msg = "Variable '%s' with TARGET attribute"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (IsNamedConstant(symbol)) { // C8106
- msg = "Named constant '%s' is not allowed in an equivalence set"_err_en_US;
- } else if (InCommonWithBind(symbol)) { // C8106
- msg = "Variable '%s' in common block with BIND attribute"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (const auto *type{symbol.GetType()}) {
- const auto *derived{type->AsDerived()};
- if (derived && !derived->IsVectorType()) {
- if (const auto *comp{FindUltimateComponent(
- *derived, IsAllocatableOrPointer)}) { // C8106
- msg = IsPointer(*comp)
- ? "Derived type object '%s' with pointer ultimate component"
- " is not allowed in an equivalence set"_err_en_US
- : "Derived type object '%s' with allocatable ultimate component"
- " is not allowed in an equivalence set"_err_en_US;
- } else if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
- msg = "Nonsequence derived type object '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- }
- } else if (IsAutomatic(symbol)) {
- msg = "Automatic object '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- }
- }
- if (!msg.text().empty()) {
- context_.Say(name.source, std::move(msg), name.source);
- return false;
- }
- return true;
+ return currObject_.symbol != nullptr;
}
bool EquivalenceSets::CheckArrayBound(const parser::Expr &bound) {
diff --git a/flang/test/Semantics/equivalence01.f90 b/flang/test/Semantics/equivalence01.f90
index 7ef47fb554b5e..ec68e9066a29a 100644
--- a/flang/test/Semantics/equivalence01.f90
+++ b/flang/test/Semantics/equivalence01.f90
@@ -244,3 +244,12 @@ module m18
type(t1) x
common x
end
+
+subroutine s19
+ entry e19
+ !ERROR: 'e19' in equivalence set is not a data object
+ equivalence (e19, j)
+ !ERROR: 'e20' in equivalence set is not a data object
+ equivalence (e20, j)
+ entry e20
+end
More information about the flang-commits
mailing list