[flang] [OpenMP 4.5] Add semantic checks for OpenMP Private clause

[praveen]

Summary

Add the semantic checks for the OpenMP 4.5 - 2.15.3.3 Private clause.

• Pointers with the INTENT(IN) attribute may not appear in a private clause.

• Variables that appear in namelist statements may not appear in a private clause. (This check holds for firstprivate and lastprivate clauses too)

Test cases : omp-private01.f90 , omp-private02.f90 , omp-private03.f90, omp-private04.f90

[praveen]

Updated formatting

[sameeranjoshi]

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

413–431

Is it possible to extract this into a function and make it more generalized ?
I see copyprivate in OMP 4.5 standard restriction section point 10 in [2.15.4.2] too has a similar restriction, we can probably reuse it over there.

[praveen]

Moved the pointer check to separate function as per review comment

[kiranchandramohan]

Thanks for this patch. A few comments inline.

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

173

Can this be private?

flang/lib/Semantics/resolve-directives.cpp

1197

why is this check required?

1202

Can you check what is happening for this testcase here or above and why the error is being missed?

program omp_target
  integer :: a, b, c
  namelist /mylist/ a, b, c

  a = 5
  b = 10
  call sb()
contains
  subroutine sb()
  !$omp parallel private(a)
  c = a+b
  !$omp end parallel

  write(*, mylist)
  end subroutine
end program omp_target

1204

Nit: Use braced initializer here.

[kiranchandramohan]

ping.

[praveen]

Modified the logic to identify all the variables in namelist statements

[praveen]

Rebase with latest master

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

1054

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

The specific restriction that this code checks seems to have two more components. Will the checks for "in variable format expressions, and in expressions for statement function definitions," be in a separate patch?

1228

Can this error message be like, Variable in namelist %s cannot be in a ^s clause?

flang/test/Semantics/omp-private01.f90

21

Is this check required given that dummy arguments can never be part of a common block?

flang/test/Semantics/omp-private02.f90

1

Can we move omp-private03.f90, omp-private04.f90also into this file?

[praveen]

Address review comments.

[kiranchandramohan]

@praveen can you reply inline in each comment whether you have made the changes suggested, reply to the question asked, or give your opinion? That way it will be easier for me to review.

[praveen]

@kiranchandramohan Updated the reply for each of the inline comments.
Thanks!

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

413–431

Moved the code to a function as suggested . Thanks !

flang/lib/Semantics/resolve-directives.cpp

1054

@kiranchandramohan The checks for "Variable format expressions and in expressions for statement function definitions" will be handled in a separate patch.

1197

Removed the redundant check.

1202

@kiranchandramohan Thanks for pointing this out . Since only the namelist variables in the enclosing scope are considered , this error is getting missed out.

Working on modifying the code to get this working for all possible cases.

1202

@kiranchandramohan Modified the logic to identify all the namelist variables defined in different scopes and added the test cases for the same.

Thanks!

1204

Made the change as suggested.

1228

Modified the error message. Thanks!

flang/test/Semantics/omp-private01.f90

21

Removed the redundant check as suggested. Thanks!

flang/test/Semantics/omp-private02.f90

1

Moved the test cases in omp-private03.f90 and omp-private04.f90 to omp-private02.f90

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

1213–1217

Calling GetNamelistSymbols for finding all the namelist objects each time CheckObjectInNameList (for each variable in the private list) is called seems to be not optimal.

@tskeith Is there a better way to check whether a variable is part of a namelist?

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

1213–1217

I checked with others, what Peter suggested is to collect all the namelist groups' symbols once and then use it for the private clause checks. Can you try that?

[tskeith]

flang/lib/Semantics/resolve-directives.cpp

1213–1217

Another option would be to add an InNamelist flag to Symbol::Flags, similar to InDataStmt. It's probably easy to set that in resolve-names.cpp.

[praveen]

Added a flag in symbol.h to identify the symbols in namelist

[kiranchandramohan]

LGTM. Thanks @praveen.

flang/lib/Semantics/resolve-directives.cpp

1213–1217

Thanks @tskeith

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

#include "llvm/Frontend/OpenMP/OMP.cpp.inc"
   void Enter(const parser::OmpDistScheduleClause &);
   void Enter(const parser::OmpIfClause &);
   void Enter(const parser::OmpLinearClause &);
   void Enter(const parser::OmpMapClause &);
   void Enter(const parser::OmpProcBindClause &);
   void Enter(const parser::OmpReductionClause &);
   void Enter(const parser::OmpScheduleClause &);
 
 private:
   bool HasInvalidWorksharingNesting(
       const parser::CharBlock &, const OmpDirectiveSet &);
 
   // specific clause related
   bool ScheduleModifierHasType(const parser::OmpScheduleClause &,
       const parser::OmpScheduleModifierType::ModType &);
   void CheckAllowedMapTypes(const parser::OmpMapType::Type &,
       const std::list<parser::OmpMapType::Type> &);
   llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
 
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
-
   void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList);
+  void CheckIntentInPointer(
+      const parser::OmpObjectList &, const llvm::omp::Clause);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

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

if (llvm::omp::doSimdSet.test(GetContext().directive)) {
       context_.Say(GetContext().clauseSource,
           "No ORDERED clause with a parameter can be specified "
           "on the %s directive"_err_en_US,
           ContextDirectiveAsFortran());
     }
   }
 }
 
 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_shared);
   CheckIsVarPartOfAnotherVar(x.v);
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_private);
   CheckIsVarPartOfAnotherVar(x.v);
+  CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
 }
 
 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
     const parser::OmpObjectList &objList) {
 
   for (const auto &ompObject : objList.v) {
     std::visit(
         common::visitors{
             [&](const parser::Designator &designator) {
               if (std::get_if<parser::DataRef>(&designator.u)) {
                 if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
                     (parser::Unwrap<parser::ArrayElement>(ompObject))) {
                   context_.Say(GetContext().clauseSource,
                       "A variable that is part of another variable (as an "
                       "array or structure element)"
                       " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
                 }
               }
             },
for (const auto &ele : designators) {
                     &dataRef->u)}) {
           CheckDependArraySection(*arr, GetLastName(*dataRef));
         }
       }
     }
   }
 }
 
+void OmpStructureChecker::CheckIntentInPointer(
+    const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
+  for (const auto &ompObject : objectList.v) {
+    if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+      if (const auto *symbol{name->symbol}) {
+        if (const auto *commonBlockDetails{
+                symbol->detailsIf<CommonBlockDetails>()}) {
+          for (const auto &object : commonBlockDetails->objects()) {
+            if (IsPointer(*object) && IsIntentIn(*object)) {
+              context_.Say(name->source,
+                  "Pointer '%s' in the COMMON block with the INTENT(IN) "
+                  "attribute may not appear in a %s clause"_err_en_US,
+                  object->name(),
+                  parser::ToUpperCaseLetters(getClauseName(clause).str()));
+            }
+          }
+        } else {
+          if (const auto *hostAssocDetails{
+                  symbol->detailsIf<HostAssocDetails>()}) {
+            symbol = &hostAssocDetails->symbol();
+          }
+          if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
+            context_.Say(name->source,
+                "Pointer '%s' with the INTENT(IN) attribute may not appear "
+                "in a %s clause"_err_en_US,
+                symbol->name(),
+                parser::ToUpperCaseLetters(getClauseName(clause).str()));
+          }
+        }
+      }
+    }
+  }
+}
+
 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
   return llvm::omp::getOpenMPClauseName(clause);
 }
 
 llvm::StringRef OmpStructureChecker::getDirectiveName(
     llvm::omp::Directive directive) {
   return llvm::omp::getOpenMPDirectiveName(directive);
 }

flang/lib/Semantics/resolve-directives.cpp

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);
+  SymbolVector GetNamelistSymbols();
+  void GetNamelistSymbols(SymbolVector &, const Scope &);
+  void CheckObjectInNamelist(
+      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 (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
                 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);
+                  }
+
                   if (ompFlag == Symbol::Flag::OmpAllocate) {
                     AddAllocateName(name);
                   }
                 }
               }
             } else {
               // Array sections to be changed to substrings as needed
               if (AnalyzeExpr(context_, designator)) {
void ResolveOmpParts(
   }
 }
 
 void OmpAttributeVisitor::CheckDataCopyingClause(
     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
   const auto *checkSymbol{&symbol};
   if (ompFlag == Symbol::Flag::OmpCopyIn) {
     if (const auto *details{symbol.detailsIf<HostAssocDetails>()})
       checkSymbol = &details->symbol();
 
     // List of items/objects that can appear in a 'copyin' clause must be
     // '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(
+    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
+  SymbolVector namelistSymbols;
+  const auto &ultimateSymbol{symbol.GetUltimate()};
+  const auto &ultimateScope{ultimateSymbol.owner()};
+  // Identify all the namelist objects
+  GetNamelistSymbols(namelistSymbols, currScope().parent());
+  if (ultimateScope.IsModule()) {
+    GetNamelistSymbols(namelistSymbols, ultimateScope);
+  }
+  if (!namelistSymbols.empty()) {
+    auto it{std::find(
+        namelistSymbols.begin(), namelistSymbols.end(), ultimateSymbol)};
+    if (it != namelistSymbols.end()) {
+      llvm::StringRef clauseName{"PRIVATE"};
+      if (ompFlag == Symbol::Flag::OmpFirstPrivate)
+        clauseName = "FIRSTPRIVATE";
+      else if (ompFlag == Symbol::Flag::OmpLastPrivate)
+        clauseName = "LASTPRIVATE";
+      context_.Say(name.source,
+          "Variable '%s' in %s clause is used in NAMELIST statement"_err_en_US,
+          name.ToString(), clauseName.str());
+    }
+  }
+}
+
+void OmpAttributeVisitor::GetNamelistSymbols(
+    SymbolVector &namelistSymbols, const Scope &scope) {
+  const auto symbols{scope.GetSymbols()};
+  const auto &parentScope{scope.parent()};
+  for (const auto &symbol : symbols) {
+    if (const auto *namelistDetail{symbol->detailsIf<NamelistDetails>()}) {
+      for (const auto &object : namelistDetail->objects()) {
+        namelistSymbols.emplace_back(object->GetUltimate());
+      }
+    }
+  }
+  if (!parentScope.IsGlobal()) {
+    GetNamelistSymbols(namelistSymbols, parentScope);
+  }
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/omp-private01.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.3 private Clause
+! Pointers with the INTENT(IN) attribute may not appear in a private clause.
+
+subroutine omp_private(p, q)
+  integer :: a(10), b(10), c(10)
+  integer, pointer, intent(in) :: p, q
+
+  !ERROR: Dummy argument 'q' may not appear in a COMMON block
+  common /cmn/ c, q
+
+  a = 10
+  b = 20
+
+  !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a PRIVATE clause
+  !$omp parallel private(p)
+  c = a + b + p
+  !$omp end parallel
+
+  !ERROR: Pointer 'q' in the COMMON block with the INTENT(IN) attribute may not appear in a PRIVATE clause
+  !$omp parallel private(/cmn/)
+  c = c * p - q
+  !$omp end parallel
+
+  print *, c
+
+end subroutine omp_private

flang/test/Semantics/omp-private02.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.3 private Clause
+! Variables that appear in namelist statements may not appear in a private clause.
+
+program omp_private
+  integer :: a, b, c
+  namelist /mylist/ a, b, c
+
+  a = 5
+  b = 10
+
+  !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement
+  !$omp parallel private(a)
+  c = a+b
+  !$omp end parallel
+
+  write(*, mylist)
+
+end program omp_private

flang/test/Semantics/omp-private03.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.3 private Clause
+! Variables that appear in namelist statements may not appear in a private clause.
+
+program omp_private
+  integer :: a, b, c
+  namelist /mylist/ a, b, c
+
+  a = 5
+  b = 10
+
+  call sb()
+
+  contains
+    subroutine sb()
+      
+      !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement
+      !$omp parallel private(a)
+      c = a + b
+      !$omp end parallel
+
+      write(*, mylist)
+  
+    end subroutine
+
+end program omp_private

flang/test/Semantics/omp-private04.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.3 private Clause
+! Variables that appear in namelist statements may not appear in a private clause.
+
+module test
+  integer :: a, b, c
+  namelist /nlist1/ a, b
+end module
+
+program omp_private
+  use test
+
+  integer :: p(10) ,q(10) 
+  namelist /nlist2/ b, c
+
+  a = 5
+  b = 10
+ 
+  !ERROR: Variable 'a' in PRIVATE clause is used in NAMELIST statement
+  !ERROR: Variable 'b' in PRIVATE clause is used in NAMELIST statement
+  !$omp parallel private(a, b)
+  c = a + b
+  !$omp end parallel
+  
+  call sb()
+
+  contains 
+    subroutine sb()
+      namelist /nlist3/ c, p, q
+      
+      !ERROR: Variable 'c' in PRIVATE clause is used in NAMELIST statement
+      !$omp parallel private(c)
+      p = c * b
+      q = p * a
+      !$omp end parallel
+     
+      write(*, nlist1)
+      write(*, nlist2)
+      write(*, nlist3)
+
+    end subroutine       
+
+end program omp_private