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

[Peter Klausler via flang-commits]

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

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

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

>From 4f01a5cb66379331194e8d5d8f1314519e7233fb Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 18 Jan 2024 13:06:06 -0800
Subject: [PATCH] [flang] More Cray pointee checks

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

Fixes llvm-test-suite/Fortran/gfortran/regression/cray_pointers_4.f90.
---
 flang/lib/Semantics/check-declarations.cpp | 14 ++++++++++++++
 flang/test/Semantics/declarations08.f90    |  8 ++++++++
 2 files changed, 22 insertions(+)
 create mode 100644 flang/test/Semantics/declarations08.f90

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 8315864bcb718d..8f0c5ccb79f291 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 00000000000000..bd14131b33c286
--- /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