[flang-commits] [PATCH] D134485: [flang] Fix spurious error with COMMON and EQUIVALENCE

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D134485

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


Index: flang/test/Semantics/offsets03.f90
===================================================================
--- flang/test/Semantics/offsets03.f90
+++ flang/test/Semantics/offsets03.f90
@@ -60,4 +60,8 @@
   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
Index: flang/lib/Semantics/compute-offsets.cpp
===================================================================
--- flang/lib/Semantics/compute-offsets.cpp
+++ flang/lib/Semantics/compute-offsets.cpp
@@ -173,9 +173,13 @@
       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,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D134485.462304.patch
Type: text/x-patch
Size: 1721 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220922/05205912/attachment.bin>