[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.
tahonermann · May 9, 2024 · d742c2a · d742c2a
1 parent bce3132
commit d742c2a
Show file tree

Hide file tree

Showing 4 changed files with 91 additions and 82 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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