[flang-commits] [flang] [flang] More Cray pointee checks (PR #78624)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

Cray pointees may not appear in COMMON blocks or EQUIVALENCE groups.

Fixes llvm-test-suite/Fortran/gfortran/regression/cray_pointers_4.f90.

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


2 Files Affected:

- (modified) flang/lib/Semantics/check-declarations.cpp (+14) 
- (added) flang/test/Semantics/declarations08.f90 (+8) 


``````````diff
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 8315864bcb718d6..8f0c5ccb79f2913 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -455,6 +455,13 @@ void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
   if (symbol.attrs().test(Attr::BIND_C)) {
     CheckBindC(symbol);
   }
+  for (MutableSymbolRef ref : symbol.get<CommonBlockDetails>().objects()) {
+    if (ref->test(Symbol::Flag::CrayPointee)) {
+      messages_.Say(ref->name(),
+          "Cray pointee '%s' may not be a member of a COMMON block"_err_en_US,
+          ref->name());
+    }
+  }
 }
 
 // C859, C860
@@ -2514,6 +2521,13 @@ void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) {
     }
   }
   // TODO: Move C8106 (&al.) checks here from resolve-names-utils.cpp
+  for (const EquivalenceObject &object : set) {
+    if (object.symbol.test(Symbol::Flag::CrayPointee)) {
+      messages_.Say(object.symbol.name(),
+          "Cray pointee '%s' may not be a member of an EQUIVALENCE group"_err_en_US,
+          object.symbol.name());
+    }
+  }
 }
 
 void CheckHelper::CheckBlockData(const Scope &scope) {
diff --git a/flang/test/Semantics/declarations08.f90 b/flang/test/Semantics/declarations08.f90
new file mode 100644
index 000000000000000..bd14131b33c2866
--- /dev/null
+++ b/flang/test/Semantics/declarations08.f90
@@ -0,0 +1,8 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+pointer(p,x)
+!ERROR: Cray pointee 'y' may not be a member of an EQUIVALENCE group
+pointer(p,y)
+!ERROR: Cray pointee 'x' may not be a member of a COMMON block
+common x
+equivalence(y,z)
+end

``````````

</details>


https://github.com/llvm/llvm-project/pull/78624