From 450d89321f658be4ad1f6188117304a292e4285d Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Mon, 11 Sep 2023 12:01:31 -0700
Subject: [PATCH] [flang] Fix bogus error w/ COMMON & EQUIVALENCE

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 https://github.com/llvm/llvm-project/issues/65922.

Pull request: https://github.com/llvm/llvm-project/pull/66254
---
 flang/lib/Semantics/compute-offsets.cpp | 11 +++++++----
 flang/test/Semantics/block-data01.f90   |  4 ++++
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index c44660925622b..139a8eb7c8c37 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 7065bff75ddf7..30c39c3212f36 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