[Flang][OpenMP] Add semantic checks for OpenMP copyin clause.

Add the 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 Reviewed By: kiranchandramohan Differential Revision: https://reviews.llvm.org/D89385
llvm · Nov 4, 2020 · a4a4c50 · a4a4c50
1 parent 0314dff
commit a4a4c50
Show file tree

Hide file tree

Showing 8 changed files with 197 additions and 13 deletions.
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
@@ -503,6 +503,8 @@ class Symbol {
       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,

diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
@@ -223,7 +223,7 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
 
   bool Pre(const parser::SpecificationPart &x) {
     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
-    return false;
+    return true;
   }
 
   bool Pre(const parser::OpenMPBlockConstruct &);
@@ -269,6 +269,10 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
     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 &);
 
@@ -292,6 +296,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   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
 
@@ -320,6 +327,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   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>
@@ -869,7 +879,7 @@ 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) {
@@ -922,9 +932,14 @@ Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
               : 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(
@@ -941,12 +956,16 @@ void OmpAttributeVisitor::ResolveOmpObject(
           [&](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 (ompFlag == Symbol::Flag::OmpAllocate) {
-                  AddAllocateName(name);
+                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 {
@@ -963,15 +982,21 @@ void OmpAttributeVisitor::ResolveOmpObject(
           },
           [&](const parser::Name &name) { // common block
             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
-              CheckMultipleAppearances(
-                  name, *symbol, Symbol::Flag::OmpCommonBlock);
+              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())}) {
-                  AddToContextObjectWithDSA(*resolvedObject, ompFlag);
+                  if (dataCopyingAttributeFlags.test(ompFlag)) {
+                    CheckDataCopyingClause(name, *resolvedObject, ompFlag);
+                  } else {
+                    AddToContextObjectWithDSA(*resolvedObject, ompFlag);
+                  }
                 }
               }
             } else {
@@ -1073,4 +1098,20 @@ 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());
+  }
+}
+
 } // namespace Fortran::semantics
diff --git a/flang/test/Semantics/omp-combined-constructs.f90 b/flang/test/Semantics/omp-combined-constructs.f90
@@ -53,6 +53,7 @@ program main
   !$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
@@ -98,6 +99,7 @@ program main
   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

diff --git a/flang/test/Semantics/omp-copyin01.f90 b/flang/test/Semantics/omp-copyin01.f90
@@ -0,0 +1,34 @@
+! 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
diff --git a/flang/test/Semantics/omp-copyin02.f90 b/flang/test/Semantics/omp-copyin02.f90
@@ -0,0 +1,23 @@
+! 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
diff --git a/flang/test/Semantics/omp-copyin03.f90 b/flang/test/Semantics/omp-copyin03.f90
@@ -0,0 +1,33 @@
+! 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
diff --git a/flang/test/Semantics/omp-copyin04.f90 b/flang/test/Semantics/omp-copyin04.f90
@@ -0,0 +1,26 @@
+! 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
diff --git a/flang/test/Semantics/omp-copyin05.f90 b/flang/test/Semantics/omp-copyin05.f90
@@ -0,0 +1,23 @@
+! 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