[Flang] [OpenMP] Add semantic check for OpenMP private ,firstprivate and lastprivate clauses

[praveen]

Summary

OpenMP 4.5 - Variables that appear in expressions for statement function definitions may not appear in private, firstprivate or lastprivate clauses.

Test case : omp-private03.f90

[praveen]

"Variables that appear in namelist statements, in variable format expressions, or in expressions for statement function definitions, may not appear in a firstprivate clause."

@kiranchandramohan I was not able to find the implementation for the "variable format expressions" . Do we have support for this part ?

[kiranchandramohan]

LGTM.

In D93213#2452004, @praveen wrote:

"Variables that appear in namelist statements, in variable format expressions, or in expressions for statement function definitions, may not appear in a firstprivate clause."

@kiranchandramohan I was not able to find the implementation for the "variable format expressions" . Do we have support for this part ?

I believe "variable format expressions" are not supported so we can skip this check,

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

237

We have an ordering issue here. OmpAttributeVisitor (this class) is called as part of resolvenames which happens before the parse-tree rewrite. Problem is that before the parse-tree rewrite there are array expressions which are mis-parsed as statement functions. So this function will be called on a lot of statement functions which are not actually statement functions and can cause problems.

flang/lib/Semantics/resolve-directives.cpp

public:
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
 
   bool Pre(const parser::SpecificationPart &x) {
     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
     return true;
   }
 
+  bool Pre(const parser::StmtFunctionStmt &x) {
+    const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
+    if (const auto *expr{GetExpr(parsedExpr)}) {
+      for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
+        if (!IsStmtFunctionDummy(symbol)) {
+          stmtFunctionExprSymbols_.insert(symbol.GetUltimate());
+        }
+      }
+    }
+    return true;
+  }
+
   bool Pre(const parser::OpenMPBlockConstruct &);
   void Post(const parser::OpenMPBlockConstruct &);
 
   void Post(const parser::OmpBeginBlockDirective &) {
     GetContext().withinConstruct = true;
   }
 
   bool Pre(const parser::OpenMPLoopConstruct &);
private:
   static constexpr Symbol::Flags ompFlagsRequireMark{
       Symbol::Flag::OmpThreadprivate};
 
   static constexpr Symbol::Flags dataCopyingAttributeFlags{
       Symbol::Flag::OmpCopyIn};
 
   std::vector<const parser::Name *> allocateNames_; // on one directive
   SymbolSet privateDataSharingAttributeObjects_; // on one directive
+  SymbolSet stmtFunctionExprSymbols_;
 
   void AddAllocateName(const parser::Name *&object) {
     allocateNames_.push_back(object);
   }
   void ClearAllocateNames() { allocateNames_.clear(); }
 
   void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
     privateDataSharingAttributeObjects_.insert(object);
private:
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
       const parser::Name &, const Symbol &, Symbol::Flag);
 
   void CheckDataCopyingClause(
       const parser::Name &, const Symbol &, Symbol::Flag);
 
   void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);
-  void CheckObjectInNamelist(
+  void CheckPrivateDSAObject(
       const parser::Name &, const Symbol &, Symbol::Flag);
 };
 
 template <typename T>
 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
     const Symbol &object) {
   auto it{dataSharingAttributeObjects_.find(object)};
   return it != dataSharingAttributeObjects_.end();
std::visit(
                 if (dataCopyingAttributeFlags.test(ompFlag)) {
                   CheckDataCopyingClause(*name, *symbol, ompFlag);
                 } else {
                   AddToContextObjectWithDSA(*symbol, ompFlag);
                   if (dataSharingAttributeFlags.test(ompFlag)) {
                     CheckMultipleAppearances(*name, *symbol, ompFlag);
                   }
                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
-                    CheckObjectInNamelist(*name, *symbol, ompFlag);
+                    CheckPrivateDSAObject(*name, *symbol, ompFlag);
                   }
 
                   if (ompFlag == Symbol::Flag::OmpAllocate) {
                     AddAllocateName(name);
                   }
                 }
               }
             } else {
if (ompFlag == Symbol::Flag::OmpCopyIn) {
     // 'threadprivate'
     if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate))
       context_.Say(name.source,
           "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
           checkSymbol->name());
   }
 }
 
-void OmpAttributeVisitor::CheckObjectInNamelist(
+void OmpAttributeVisitor::CheckPrivateDSAObject(
     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
-  if (symbol.GetUltimate().test(Symbol::Flag::InNamelist)) {
-    llvm::StringRef clauseName{"PRIVATE"};
-    if (ompFlag == Symbol::Flag::OmpFirstPrivate)
-      clauseName = "FIRSTPRIVATE";
-    else if (ompFlag == Symbol::Flag::OmpLastPrivate)
-      clauseName = "LASTPRIVATE";
+  const auto &ultimateSymbol{symbol.GetUltimate()};
+
+  if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
     context_.Say(name.source,
         "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
         name.ToString(), clauseName.str());
   }
+
+  if (stmtFunctionExprSymbols_.find(ultimateSymbol) !=
+      stmtFunctionExprSymbols_.end()) {
+    context_.Say(name.source,
+        "Variable '%s' in STATEMENT FUNCTION expression cannot be in a "
+        "%s clause"_err_en_US,
+        name.ToString(), clauseName.str());
+  }
 }
 
 } // namespace Fortran::semantics

flang/test/Semantics/omp-private03.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! Variables that appear in expressions for statement function definitions
+! may not appear in private, firstprivate or lastprivate clauses.
+
+subroutine stmt_function(temp)
+
+  integer :: i, p, q, r
+  real :: c, f, s, v, t(10)
+  real, intent(in) :: temp
+
+  c(temp) = p * (temp - q) / r
+  f(temp) = q + (temp * r/p)
+  v(temp) = c(temp) + f(temp)/2 - s
+
+  p = 5
+  q = 32
+  r = 9
+
+  !ERROR: Variable 'p' in STATEMENT FUNCTION expression cannot be in a PRIVATE clause
+  !$omp parallel private(p)
+  s = c(temp)
+  !$omp end parallel
+
+  !ERROR: Variable 's' in STATEMENT FUNCTION expression cannot be in a FIRSTPRIVATE clause
+  !$omp parallel firstprivate(s)
+  s = s + f(temp)
+  !$omp end parallel
+
+  !ERROR: Variable 's' in STATEMENT FUNCTION expression cannot be in a LASTPRIVATE clause
+  !$omp parallel do lastprivate(s, t)
+  do i = 1, 10
+    t(i) = v(temp) + i - s
+  end do
+  !$omp end parallel do
+
+  print *, t
+
+end subroutine stmt_function