[flang-commits] [flang] 166563f - [flang] Fix spurious error with COMMON and EQUIVALENCE

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-09-23T15:32:39-07:00
New Revision: 166563fdc7e92130122fe386c29806ac4048a907

URL: https://github.com/llvm/llvm-project/commit/166563fdc7e92130122fe386c29806ac4048a907
DIFF: https://github.com/llvm/llvm-project/commit/166563fdc7e92130122fe386c29806ac4048a907.diff

LOG: [flang] Fix spurious error with COMMON and EQUIVALENCE

f18 emits an error message when two objects related by EQUIVALENCE
to a third are specified as members of a COMMON block.  This is not
always a sign of an error, however; it is possible for multiple objects
in a COMMON block to all be equivalenced to distinct offsets in another
object in a way that is consistent.  So refine the check.

Differential Revision: https://reviews.llvm.org/D134485

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 23232d6ef38b..511c8453c47a 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -173,9 +173,13 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
       Symbol &base{*dep.symbol};
       if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
         if (baseBlock == &commonBlock) {
-          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());
+          if (base.offset() != symbol.offset() - dep.offset ||
+              std::find(details.objects().begin(), details.objects().end(),
+                  base) != details.objects().end()) {
+            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)
           context_.Say(errorSite,
               "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,

diff  --git a/flang/test/Semantics/offsets03.f90 b/flang/test/Semantics/offsets03.f90
index 45d8d80444ae..9d2716db7fc5 100644
--- a/flang/test/Semantics/offsets03.f90
+++ b/flang/test/Semantics/offsets03.f90
@@ -60,4 +60,8 @@ module me
   integer :: i5, j5, l5(10)
   equivalence(l5(1), i5)
   common /common7/ j5, i5   ! CHECK: common7 size=44 offset=0: CommonBlockDetails alignment=4:
+
+  real :: a1, a2, a3(2)
+  equivalence(a1,a3(1)),(a2,a3(2))
+  common /common8/ a1, a2   ! CHECK: common8 size=8 offset=0: CommonBlockDetails alignment=4:
 end