[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

165–166

Can this be private?

flang/lib/Semantics/resolve-directives.cpp

1087

why is this check required?

1092

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

1094

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

948

"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?

1102

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

flang/test/Semantics/omp-private01.f90

22

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

flang/test/Semantics/omp-private02.f90

2

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

948

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

1087

Removed the redundant check.

1092

@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.

1092

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

Thanks!

1094

Made the change as suggested.

1102

Modified the error message. Thanks!

flang/test/Semantics/omp-private01.f90

22

Removed the redundant check as suggested. Thanks!

flang/test/Semantics/omp-private02.f90

2

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

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

1087–1091

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

1087–1091

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

1087–1091

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

1087–1091

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:
+  void CheckIntentInPointer(
+      const parser::Name &, const Symbol &, const llvm::omp::Clause);
 
+private:
   bool HasInvalidWorksharingNesting(
       const parser::CharBlock &, const OmpDirectiveSet &);
 
   // specific clause related
   bool ScheduleModifierHasType(const parser::OmpScheduleClause &,
       const parser::OmpScheduleModifierType::ModType &);
 
   llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

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

if (llvm::omp::doSimdSet.test(GetContext().directive)) {
           ContextDirectiveAsFortran());
     }
   }
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Priority &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_priority);
   RequiresPositiveParameter(llvm::omp::Clause::OMPC_priority, x.v);
 }
-void OmpStructureChecker::Enter(const parser::OmpClause::Private &) {
+void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_private);
+  // Pointers with the INTENT(IN) attribute may not appear in a private clause
+  for (const auto &ompObject : x.v.v) {
+    if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+      if (const auto *symbol{name->symbol}) {
+        if (const auto *commonBlockDetails{
+                symbol->detailsIf<CommonBlockDetails>()}) {
+          for (auto &object : commonBlockDetails->objects()) {
+            CheckIntentInPointer(
+                *name, *object, llvm::omp::Clause::OMPC_private);
+          }
+        } else {
+          if (const auto *hostAssocDetails{
+                  symbol->detailsIf<HostAssocDetails>()}) {
+            symbol = &hostAssocDetails->symbol();
+          }
+          CheckIntentInPointer(*name, *symbol, llvm::omp::Clause::OMPC_private);
+        }
+      }
+    }
+  }
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Safelen &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_safelen);
   RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_safelen, x.v);
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &) {
   CheckAllowed(llvm::omp::Clause::OMPC_shared);
 }
if (ScheduleModifierHasType(
         context_.Say(GetContext().clauseSource,
             "The NONMONOTONIC modifier can only be specified with "
             "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
       }
     }
   }
 }
 
+void OmpStructureChecker::CheckIntentInPointer(const parser::Name &name,
+    const Symbol &symbol, const llvm::omp::Clause clause) {
+  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);
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-directives.cpp

private:
   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
   Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
       const parser::Name &, const Symbol &, Symbol::Flag);
+  SymbolVector GetNamelistSymbols();
+  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();
 }

 void OmpAttributeVisitor::ResolveOmpObject(
     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
   std::visit(
       common::visitors{
           [&](const parser::Designator &designator) {
             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
               if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
                 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)) {
                 if (std::holds_alternative<parser::Substring>(designator.u)) {
if (!context.AnyFatalError()) {
       // the corresponding DoConstruct, a second walk is to adjust the
       // symbols for all the data-refs of that loop iteration variable
       // prior to the DoConstruct.
       OmpAttributeVisitor{context}.Walk(node);
     }
   }
 }
 
+void OmpAttributeVisitor::CheckObjectInNamelist(
+    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
+  auto namelistSymbols = GetNamelistSymbols();
+  if (!namelistSymbols.empty()) {
+    const auto *target{&symbol};
+    if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+      if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
+        target = &details->symbol();
+      }
+    }
+    auto it{std::find(namelistSymbols.begin(), namelistSymbols.end(), *target)};
+    if (it != namelistSymbols.end()) {
+      const auto clauseName{ompFlag == Symbol::Flag::OmpPrivate ? "PRIVATE"
+              : ompFlag == Symbol::Flag::OmpFirstPrivate        ? "FIRSTPRIVATE"
+                                                         : "LASTPRIVATE"};
+      context_.Say(name.source,
+          "Variable '%s' in %s clause is used in NAMELIST statement"_err_en_US,
+          name.ToString(), clauseName);
+    }
+  }
+}
+
+SymbolVector OmpAttributeVisitor::GetNamelistSymbols() {
+  SymbolVector namelistSymbols;
+  const auto symbols{currScope().parent().GetSymbols()};
+  for (const auto &symbol : symbols) {
+    if (const auto *namelistDetail{symbol->detailsIf<NamelistDetails>()}) {
+      for (auto &object : namelistDetail->objects()) {
+        namelistSymbols.emplace_back(*object);
+      }
+    }
+  }
+  return namelistSymbols;
+}
+
 } // 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_target(p)
+  integer :: a(10), b(10), c(10)
+  integer, pointer, intent(in) :: p
+
+  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
+
+  print *, c
+
+end subroutine omp_target

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
+! Pointers with the INTENT(IN) attribute may not appear in a private clause.
+
+subroutine omp_target(p)
+  integer :: a(10), b(10), c(10)
+  integer, pointer, intent(in) :: p
+
+  !ERROR: Dummy argument 'p' may not appear in a COMMON block
+  common /cmn/ c, p
+
+  a = 10
+  b = 20
+
+  !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a PRIVATE clause
+  !$omp parallel private(/cmn/)
+  c = a + b + p
+  !$omp end parallel
+
+  print *, c
+
+end subroutine omp_target

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_target
+  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_target