[flang] Fix bogus error w/ COMMON & EQUIVALENCE

[klausler]

Semantic checking of COMMON blocks and EQUIVALENCE sets has an assumption that the base storage sequence object of each COMMON block object will also be in that COMMON block's list of objects, and emits an error message when this is not the case. This assumption is faulty; it is possible for a base object to have its COMMON block set during offset assignment.

Fixes #65922.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Changes

Semantic checking of COMMON blocks and EQUIVALENCE sets has an assumption that the base storage sequence object of each COMMON block object will also be in that COMMON block's list of objects, and emits an error message when this is not the case. This assumption is faulty; it is possible for a base object to have its COMMON block set during offset assignment.

Fixes #65922.

Full diff: https://github.com/llvm/llvm-project/pull/66254.diff

2 Files Affected:

• (modified) flang/lib/Semantics/compute-offsets.cpp (+7-4)
• (modified) flang/test/Semantics/block-data01.f90 (+4)

diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index c44660925622bf4..139a8eb7c8c3771 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -152,7 +152,8 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
   alignment_ = 0;
   std::size_t minSize{0};
   std::size_t minAlignment{0};
-  for (auto &object : details.objects()) {
+  UnorderedSymbolSet previous;
+  for (auto object : details.objects()) {
     Symbol &symbol{*object};
     auto errorSite{
         commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
@@ -161,6 +162,7 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
           "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
           commonBlock.name(), padding, symbol.name());
     }
+    previous.emplace(symbol);
     auto eqIter{equivalenceBlock_.end()};
     auto iter{dependents_.find(symbol)};
     if (iter == dependents_.end()) {
@@ -173,13 +175,13 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
       Symbol &base{*dep.symbol};
       if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
         if (baseBlock == &commonBlock) {
-          if (base.offset() != symbol.offset() - dep.offset ||
-              llvm::is_contained(details.objects(), base)) {
+          if (previous.find(SymbolRef{base}) == previous.end() ||
+              base.offset() != symbol.offset() - dep.offset) {
             context_.Say(errorSite,
                 "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
                 symbol.name(), base.name(), commonBlock.name());
           }
-        } else { // 8.10.3(1)
+        } else { // F'2023 8.10.3 p1
           context_.Say(errorSite,
               "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
               symbol.name(), commonBlock.name(), base.name(),
@@ -193,6 +195,7 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
         eqIter = equivalenceBlock_.find(base);
         base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
         base.set_offset(symbol.offset() - dep.offset);
+        previous.emplace(base);
       }
     }
     // Get full extent of any EQUIVALENCE block into size of COMMON ( see
diff --git a/flang/test/Semantics/block-data01.f90 b/flang/test/Semantics/block-data01.f90
index 7065bff75ddf758..30c39c3212f3687 100644
--- a/flang/test/Semantics/block-data01.f90
+++ b/flang/test/Semantics/block-data01.f90
@@ -32,4 +32,8 @@ block data foo
   integer :: inCommonF1, inCommonF2
   !ERROR: 'incommonf1' is storage associated with 'incommonf2' by EQUIVALENCE elsewhere in COMMON block /f/
   common /f/ inCommonF1, inCommonF2
+  !Regression test for llvm-project/issues/65922 - no error expected
+  common /g/ inCommonG1, inCommonG2
+  real inCommonG1(-9:10), inCommonG2(10), otherG(11)
+  equivalence (inCommonG1(1), otherG), (otherG(11), inCommonG2)
 end block data

[psteinfeld]

All builds and tests correctly and looks good.