[flang][OpenMP] Semantic checks for GROUPPRIVATE (#154779)

Author: kparzysz

flang/include/flang/Semantics/symbol.h

@@ -811,6 +811,7 @@ class Symbol {
       AccCommonBlock, AccThreadPrivate, AccReduction, AccNone, AccPreDetermined,
       // OpenMP data-sharing attribute
       OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate,
+      OmpGroupPrivate,
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapToFrom, OmpMapStorage, OmpMapDelete,
       OmpUseDevicePtr, OmpUseDeviceAddr, OmpIsDevicePtr, OmpHasDeviceAddr,

flang/lib/Semantics/check-omp-structure.cpp

@@ -1184,6 +1184,53 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
 void OmpStructureChecker::Enter(const parser::OpenMPGroupprivate &x) {
   PushContextAndClauseSets(
       x.v.DirName().source, llvm::omp::Directive::OMPD_groupprivate);
+
+  for (const parser::OmpArgument &arg : x.v.Arguments().v) {
+    auto *locator{std::get_if<parser::OmpLocator>(&arg.u)};
+    const Symbol *sym{GetArgumentSymbol(arg)};
+
+    if (!locator || !sym ||
+        (!IsVariableListItem(*sym) && !IsCommonBlock(*sym))) {
+      context_.Say(arg.source,
+          "GROUPPRIVATE argument should be a variable or a named common block"_err_en_US);
+      continue;
+    }
+
+    if (sym->has<AssocEntityDetails>()) {
+      context_.SayWithDecl(*sym, arg.source,
+          "GROUPPRIVATE argument cannot be an an ASSOCIATE name"_err_en_US);
+      continue;
+    }
+    if (auto *obj{sym->detailsIf<ObjectEntityDetails>()}) {
+      if (obj->IsCoarray()) {
+        context_.Say(arg.source,
+            "GROUPPRIVATE argument cannot be an a coarray"_err_en_US);
+        continue;
+      }
+      if (obj->init()) {
+        context_.SayWithDecl(*sym, arg.source,
+            "GROUPPRIVATE argument cannot be declared with an initializer"_err_en_US);
+        continue;
+      }
+    }
+    if (sym->test(Symbol::Flag::InCommonBlock)) {
+      context_.Say(arg.source,
+          "GROUPPRIVATE argument cannot be an a member of a common block"_err_en_US);
+      continue;
+    }
+    if (!IsCommonBlock(*sym)) {
+      const Scope &thisScope{context_.FindScope(x.v.source)};
+      if (thisScope != sym->owner()) {
+        context_.SayWithDecl(*sym, arg.source,
+            "GROUPPRIVATE argument variable must be declared in the same scope as the construct on which it appears"_err_en_US);
+        continue;
+      } else if (!thisScope.IsModule() && !sym->attrs().test(Attr::SAVE)) {
+        context_.SayWithDecl(*sym, arg.source,
+            "GROUPPRIVATE argument variable must be declared in the module scope or have SAVE attribute"_err_en_US);
+        continue;
+      }
+    }
+  }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPGroupprivate &x) {

flang/lib/Semantics/resolve-directives.cpp

@@ -391,6 +391,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
     GetContext().withinConstruct = true;
   }
 
+  bool Pre(const parser::OpenMPGroupprivate &);
+  void Post(const parser::OpenMPGroupprivate &) { PopContext(); }
+
   bool Pre(const parser::OpenMPStandaloneConstruct &x) {
     common::visit(
         [&](auto &&s) {
@@ -842,7 +845,8 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
 
   Symbol::Flags ompFlagsRequireMark{Symbol::Flag::OmpThreadprivate,
       Symbol::Flag::OmpDeclareTarget, Symbol::Flag::OmpExclusiveScan,
-      Symbol::Flag::OmpInclusiveScan, Symbol::Flag::OmpInScanReduction};
+      Symbol::Flag::OmpInclusiveScan, Symbol::Flag::OmpInScanReduction,
+      Symbol::Flag::OmpGroupPrivate};
 
   Symbol::Flags dataCopyingAttributeFlags{
       Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate};
@@ -2118,6 +2122,18 @@ void OmpAttributeVisitor::CheckAssocLoopLevel(
   }
 }
 
+bool OmpAttributeVisitor::Pre(const parser::OpenMPGroupprivate &x) {
+  PushContext(x.source, llvm::omp::Directive::OMPD_groupprivate);
+  for (const parser::OmpArgument &arg : x.v.Arguments().v) {
+    if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
+      if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
+        ResolveOmpObject(*object, Symbol::Flag::OmpGroupPrivate);
+      }
+    }
+  }
+  return true;
+}
+
 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
   const auto &beginSectionsDir{
       std::get<parser::OmpBeginSectionsDirective>(x.t)};

flang/lib/Semantics/unparse-with-symbols.cpp

@@ -47,6 +47,11 @@ class SymbolDumpVisitor {
     return true;
   }
   void Post(const parser::OmpClause &) { currStmt_ = std::nullopt; }
+  bool Pre(const parser::OpenMPGroupprivate &dir) {
+    currStmt_ = dir.source;
+    return true;
+  }
+  void Post(const parser::OpenMPGroupprivate &) { currStmt_ = std::nullopt; }
   bool Pre(const parser::OpenMPThreadprivate &dir) {
     currStmt_ = dir.source;
     return true;

flang/test/Semantics/OpenMP/groupprivate.f90

@@ -0,0 +1,47 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60
+
+module m00
+implicit none
+integer :: x = 1
+!ERROR: GROUPPRIVATE argument cannot be declared with an initializer
+!$omp groupprivate(x)
+!ERROR: GROUPPRIVATE argument should be a variable or a named common block
+!$omp groupprivate(f00)
+
+contains
+subroutine f00
+  implicit none
+  integer, save :: y
+  associate (z => y)
+  block
+    !ERROR: GROUPPRIVATE argument cannot be an an ASSOCIATE name
+    !$omp groupprivate(z)
+  end block
+  end associate
+end
+end module
+
+module m01
+implicit none
+integer :: x, y
+common /some_block/ x
+!ERROR: GROUPPRIVATE argument cannot be an a member of a common block
+!$omp groupprivate(x)
+
+contains
+subroutine f01
+  implicit none
+  integer :: z
+  !ERROR: GROUPPRIVATE argument variable must be declared in the same scope as the construct on which it appears
+  !$omp groupprivate(y)
+  !ERROR: GROUPPRIVATE argument variable must be declared in the module scope or have SAVE attribute
+  !$omp groupprivate(z)
+end
+end module
+
+module m02
+implicit none
+integer :: x(10)[*]
+!ERROR: GROUPPRIVATE argument cannot be an a coarray
+!$omp groupprivate(x)
+end module