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

[via flang-commits]

Author: Peter Klausler
Date: 2024-01-25T15:03:23-08:00
New Revision: b788d6283d160f0fcff9ca9109ea97960185dc71

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

LOG: [flang] More Cray pointee checks (#78624)

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

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

Added: 
    flang/test/Semantics/declarations08.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 31ccc77d0993fa2..d2f0c839cb5eb9f 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
@@ -2509,6 +2516,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