[flang] Better EQUIVALENCE handling

Original-commit: flang-compiler/f18@7c55097e81c9ab76953c1c652128bc9b969e6a33
Reviewed-on: https://github.com/flang-compiler/f18/pull/926
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/check-declarations.cc b/flang/lib/semantics/check-declarations.cc
index e688e3b..500e135 100644 (file)
--- a/flang/lib/semantics/check-declarations.cc
+++ b/flang/lib/semantics/check-declarations.cc
@@ -17,6 +17,7 @@
 #include "../evaluate/check-expression.h"
 #include "../evaluate/fold.h"
 #include "../evaluate/tools.h"
+#include <algorithm>
 
 namespace Fortran::semantics {
 
@@ -1039,7 +1040,39 @@ void CheckHelper::Check(const Scope &scope) {
   }
 }
 
-void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &) {
+void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) {
+  auto iter{
+      std::find_if(set.begin(), set.end(), [](const EquivalenceObject &object) {
+        return FindCommonBlockContaining(object.symbol) != nullptr;
+      })};
+  if (iter != set.end()) {
+    const Symbol &commonBlock{DEREF(FindCommonBlockContaining(iter->symbol))};
+    for (auto &object : set) {
+      if (&object != &*iter) {
+        if (auto *details{object.symbol.detailsIf<ObjectEntityDetails>()}) {
+          if (details->commonBlock()) {
+            if (details->commonBlock() != &commonBlock) {
+              if (auto *msg{messages_.Say(object.symbol.name(),
+                      "Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks"_err_en_US)}) {
+                msg->Attach(iter->symbol.name(),
+                       "Other object in EQUIVALENCE set"_en_US)
+                    .Attach(details->commonBlock()->name(),
+                        "COMMON block containing '%s'"_en_US,
+                        object.symbol.name())
+                    .Attach(commonBlock.name(),
+                        "COMMON block containing '%s'"_en_US,
+                        iter->symbol.name());
+              }
+            }
+          } else {
+            // Mark all symbols in the equivalence set with the same COMMON
+            // block
+            details->set_commonBlock(commonBlock);
+          }
+        }
+      }
+    }
+  }
   // TODO: Move C8106 (&al.) checks here from resolve-names-utils.cc
 }
 

diff --git a/flang/test/semantics/block-data01.f90 b/flang/test/semantics/block-data01.f90
index 4295e11..5abd099 100644 (file)
--- a/flang/test/semantics/block-data01.f90
+++ b/flang/test/semantics/block-data01.f90
@@ -15,5 +15,13 @@ block data foo
   common inBlankCommon
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: inDataButNotCommon
-  data inDataButNotCommon / 1 / 
+  data inDataButNotCommon /1/
+  !ERROR: Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks
+  integer :: inCommonA, inCommonB
+  common /a/ inCommonA, /b/ inCommonB
+  equivalence(inCommonA, inCommonB)
+  integer :: inCommonD, initialized ! ok
+  common /d/ inCommonD
+  equivalence(inCommonD, initialized)
+  data initialized /2/
 end block data