[Flang][OpenMP 4.5] Add semantic check for OpenMP copyin clause

[praveen]

Summary

Add semantic checks for the OpenMP 4.5 - 2.15.4.1 copyin clause.

Resolve OpenMPThreadprivate directive since the list of items specified in copyin clause should be threadprivate.

Test cases : omp-copyin01.f90 , omp-copyin02.f90 , omp-copyin03.f90 , omp-copyin04.f90 , omp-copyin05.f90

[praveen]

Updated formatting

[kiranchandramohan]

Thanks @praveen for this patch. Can you add a few positive tests as well?

flang/lib/Semantics/resolve-directives.cpp

226–239

Why is this change required?

961

Nit: I think in general early returns are not used widely in the code base.

flang/test/Semantics/omp-copyin01.f90

12

Nit: a space before 'j'.

flang/test/Semantics/omp-copyin02.f90

20

Nit: A space between print and *.

[praveen]

Added positive test cases , formatting as per review comments

[SouraVX]

flang/include/flang/Semantics/symbol.h

506

NIT: attribute ?

flang/lib/Semantics/resolve-directives.cpp

239

Please refer to comment in flang/lib/Semantics/resolve-directives.cpp:898 below

277

Not sure of this version specific comment, since we've not followed that consistently.
@kiranchandramohan @jdoerfert @kiranktp Please share your opinion.

882

It seems to me that you're resolving ThreadPrivate too ? (Since CopyIn requires ThreadPrivate in first place).
Could you please modify the revision summary to reflect the intent.

936

Can we have a better name to convey the intent ?

962

This seems to be un-intentional formatting introduced by your editor. Could you please correct this ?

986

NIT: Formatting ?

1108

NIT: How about re-phrasing this as:

List of items/objects that can appear in an `copyin` clause must be `threadprivate`.

[praveen]

Address the review comments and update the summary.

[praveen]

@kiranchandramohan @SouraVX Thanks for the review ! I have addressed the review comments as specified.

flang/lib/Semantics/resolve-directives.cpp

226–239

@kiranchandramohan This change is required to identify the list items present on the OpenMPThreadprivate directive as the semantic checks for the declarative directives are not yet implemented at present .

277

Removed the version specific comment.

882

@SouraVX Yes . I am resolving ThreadPrivate as it is required for Copyin . Updated the revision summary . Thanks!

961

Modified to if - else block instead of early return

[kiranchandramohan]

flang/lib/Semantics/resolve-directives.cpp

226–239

I didn't check this in detail. By default, the walk should visit all kinds of nodes including Threadprivate and the code in Pre(threadprivate) processes the list of variables.

[praveen]

Removed redundant code used to resolve threadprivate directive as per review comments.

[kiranchandramohan]

LGTM.

flang/include/flang/Semantics/symbol.h

ENUM_CLASS(Flag,
       // OpenACC data-mapping attribute
       AccCopyIn, AccCopyOut, AccCreate, AccDelete, AccPresent,
       // OpenACC miscellaneous flags
       AccCommonBlock, AccThreadPrivate, AccReduction, AccNone, AccPreDetermined,
       // OpenMP data-sharing attribute
       OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate,
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete,
+      // OpenMP data-copying attribute
+      OmpCopyIn,
       // OpenMP miscellaneous flags
       OmpCommonBlock, OmpReduction, OmpAllocate, OmpDeclareSimd,
       OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction, OmpFlushed,
       OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined);
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   const Scope &owner() const { return *owner_; }
   const SourceName &name() const { return name_; }

flang/lib/Semantics/resolve-directives.cpp

explicit OmpAttributeVisitor(SemanticsContext &context)
       : DirectiveAttributeVisitor(context) {}
 
   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
   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 false;
+    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 &);
   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
   void Post(const parser::OmpBeginLoopDirective &) {
     GetContext().withinConstruct = true;
   }
   bool Pre(const parser::DoConstruct &);
 
   bool Pre(const parser::OpenMPSectionsConstruct &);
   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenMPThreadprivate &);
   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
public:
   bool Pre(const parser::OmpClause::Firstprivate &x) {
     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
     return false;
   }
   bool Pre(const parser::OmpClause::Lastprivate &x) {
     ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
     return false;
   }
+  bool Pre(const parser::OmpClause::Copyin &x) {
+    ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);
+    return false;
+  }
 
   void Post(const parser::Name &);
 
 private:
   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
 
   static constexpr Symbol::Flags dataSharingAttributeFlags{
       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
       Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
 
   static constexpr Symbol::Flags privateDataSharingAttributeFlags{
       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
       Symbol::Flag::OmpLastPrivate};
 
   static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
       Symbol::Flag::OmpReduction};
 
   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
 
   void AddAllocateName(const parser::Name *&object) {
     allocateNames_.push_back(object);
   }
   void ClearAllocateNames() { allocateNames_.clear(); }
 
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);
+
+  void CheckDataCopyingClause(
+      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();
 }
bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
   ClearDataSharingAttributeObjects();
   return true;
 }
 
 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
   const auto &list{std::get<parser::OmpObjectList>(x.t)};
   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
-  return false;
+  return true;
 }
 
 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
   if (!dirContext_.empty()) {
     switch (x.v) {
     case parser::OmpDefaultClause::Type::Private:
       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
       break;

 
 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
     const parser::Name *name) {
   if (auto *prev{name
               ? GetContext().scope.parent().FindCommonBlock(name->source)
               : nullptr}) {
     name->symbol = prev;
     return prev;
-  } else {
-    return nullptr;
   }
+  // Check if the Common Block is declared in the current scope
+  if (auto *commonBlockSymbol{
+          name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
+    name->symbol = commonBlockSymbol;
+    return commonBlockSymbol;
+  }
+  return nullptr;
 }
 
 void OmpAttributeVisitor::ResolveOmpObjectList(
     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
   for (const auto &ompObject : ompObjectList.v) {
     ResolveOmpObject(ompObject, ompFlag);
   }
 }
 
 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())}) {
+                if (dataCopyingAttributeFlags.test(ompFlag)) {
+                  CheckDataCopyingClause(*name, *symbol, ompFlag);
+                } else {
                   AddToContextObjectWithDSA(*symbol, ompFlag);
                   if (dataSharingAttributeFlags.test(ompFlag)) {
                     CheckMultipleAppearances(*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)) {
                   context_.Say(designator.source,
                       "Substrings are not allowed on OpenMP "
                       "directives or clauses"_err_en_US);
                 }
               }
               // other checks, more TBD
             }
           },
           [&](const parser::Name &name) { // common block
             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
+              if (!dataCopyingAttributeFlags.test(ompFlag)) {
                 CheckMultipleAppearances(
                     name, *symbol, Symbol::Flag::OmpCommonBlock);
+              }
               // 2.15.3 When a named common block appears in a list, it has the
               // same meaning as if every explicit member of the common block
               // appeared in the list
               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
                 if (auto *resolvedObject{
                         ResolveOmp(*object, ompFlag, currScope())}) {
+                  if (dataCopyingAttributeFlags.test(ompFlag)) {
+                    CheckDataCopyingClause(name, *resolvedObject, ompFlag);
+                  } else {
                     AddToContextObjectWithDSA(*resolvedObject, ompFlag);
                   }
                 }
+              }
             } else {
               context_.Say(name.source, // 2.15.3
                   "COMMON block must be declared in the same scoping unit "
                   "in which the OpenMP directive or clause appears"_err_en_US);
             }
           },
       },
       ompObject.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::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());
+  }
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/omp-combined-constructs.f90

program main
 
   !$omp target parallel map(tofrom:a)
   do i = 1, N
      a(i) = 3.14
   enddo
   !$omp end target parallel
 
   !ERROR: COPYIN clause is not allowed on the TARGET PARALLEL directive
+  !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
   !$omp target parallel copyin(a)
   do i = 1, N
      a(i) = 3.14
   enddo
   !$omp end target parallel
 
   !$omp target parallel do device(0)
   do i = 1, N
program main
   !$omp end target parallel do
 
   !$omp target parallel do map(tofrom:a)
   do i = 1, N
      a(i) = 3.14
   enddo
   !$omp end target parallel do
 
+  !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
   !$omp target parallel do copyin(a)
   do i = 1, N
      a(i) = 3.14
   enddo
   !$omp end target parallel do
 
   !$omp target teams map(a)
   do i = 1, N

flang/test/Semantics/omp-copyin01.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.4.1 copyin Clause
+! A list item that appears in a copyin clause must be threadprivate
+
+program omp_copyin
+
+  integer :: i
+  integer, save :: k
+  integer :: a(10), b(10)
+  common /cmn/ j
+
+  k = 10
+
+  !ERROR: Non-THREADPRIVATE object 'k' in COPYIN clause
+  !$omp parallel do copyin(k)
+  do i = 1, 10
+    a(i) = k + i
+    j = j + a(i)
+  end do
+  !$omp end parallel do
+
+  print *, a
+
+  !ERROR: Non-THREADPRIVATE object 'j' in COPYIN clause
+  !$omp parallel do copyin(/cmn/)
+  do i = 1, 10
+    b(i) = a(i) + j
+  end do
+  !$omp end parallel do
+
+  print *, b
+
+end program omp_copyin

flang/test/Semantics/omp-copyin02.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.4.1 copyin Clause
+! A common block name that appears in a copyin clause must be declared to be
+! a common block in the same scoping unit in which the copyin clause appears.
+
+subroutine copyin()
+  integer :: a = 10
+  common /cmn/ a
+
+  !$omp threadprivate(/cmn/)
+  call copyin_clause()
+
+  contains
+
+    subroutine copyin_clause()
+      !ERROR: COMMON block must be declared in the same scoping unit in which the OpenMP directive or clause appears
+      !$omp parallel copyin(/cmn/)
+      print *, a
+      !$omp end parallel
+    end subroutine copyin_clause
+
+end subroutine copyin

flang/test/Semantics/omp-copyin03.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.4.1 copyin Clause
+! A list item that appears in a copyin clause must be threadprivate.
+! Named variables appearing in a threadprivate common block may be specified
+! It is not necessary to specify the whole common block.
+
+program omp_copyin
+
+  integer :: a(10), b(10)
+  common /cmn/ j, k
+
+  !$omp threadprivate(/cmn/)
+
+  j = 20
+  k = 10
+
+  !$omp parallel copyin(/cmn/)
+  a(:5) = k
+  b(:5) = j
+  !$omp end parallel
+
+  j = j + k
+  k = k * j
+
+  !$omp parallel copyin(j, k)
+  a(6:) = j
+  b(6:) = k
+  !$omp end parallel
+
+  print *, a, b
+
+end program omp_copyin

flang/test/Semantics/omp-copyin04.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.4.1 copyin Clause
+! A list item that appears in a copyin clause must be threadprivate
+
+program omp_copyin
+
+  integer :: i
+  integer, save :: j, k
+  integer :: a(10), b(10)
+
+  !$omp threadprivate(j, k)
+
+  j = 20
+  k = 10
+
+  !$omp parallel do copyin(j, k)
+  do i = 1, 10
+    a(i) = k + i
+    b(i) = j + i
+  end do
+  !$omp end parallel do
+
+  print *, a, b
+
+end program omp_copyin

flang/test/Semantics/omp-copyin05.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.4.1 copyin Clause
+! A common block name that appears in a copyin clause must be declared to be
+! a common block in the same scoping unit in which the copyin clause appears.
+
+subroutine copyin()
+  call copyin_clause()
+
+  contains
+
+    subroutine copyin_clause()
+      integer :: a = 20
+      common /cmn/ a
+
+      !$omp threadprivate(/cmn/)
+
+      !$omp parallel copyin(/cmn/)
+      print *, a
+      !$omp end parallel
+    end subroutine copyin_clause
+
+end subroutine copyin