[flang-commits] [flang] 94b4a98 - [flang] Fix bogus error w/ COMMON & EQUIVALENCE (#66254)

[via flang-commits]

Author: Peter Klausler
Date: 2023-09-18T12:24:19-07:00
New Revision: 94b4a98681bed2674d12888bffed597945fd065c

URL: https://github.com/llvm/llvm-project/commit/94b4a98681bed2674d12888bffed597945fd065c
DIFF: https://github.com/llvm/llvm-project/commit/94b4a98681bed2674d12888bffed597945fd065c.diff

LOG: [flang] Fix bogus error w/ COMMON & EQUIVALENCE (#66254)

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.

Added: 
    

Modified: 
    flang/lib/Semantics/compute-offsets.cpp
    flang/test/Semantics/block-data01.f90

Removed: 
    


################################################################################
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