[flang-commits] [flang] c42f5ca - [Flang][OpenMP] Add semantic checks for OpenMP Workshare Construct

via flang-commits flang-commits at lists.llvm.org
Tue Jan 19 06:35:44 PST 2021


Author: Praveen
Date: 2021-01-19T20:00:12+05:30
New Revision: c42f5ca3d84c7b0d4e735ab3794718c429369309

URL: https://github.com/llvm/llvm-project/commit/c42f5ca3d84c7b0d4e735ab3794718c429369309
DIFF: https://github.com/llvm/llvm-project/commit/c42f5ca3d84c7b0d4e735ab3794718c429369309.diff

LOG: [Flang][OpenMP] Add semantic checks for OpenMP Workshare Construct

Add Semantic checks for OpenMP 4.5 - 2.7.4 Workshare Construct.

 - The structured block in a workshare construct may consist of only
   scalar or array assignments, forall or where statements,
   forall, where, atomic, critical or parallel constructs.

 - All array assignments, scalar assignments, and masked array
   assignments must be intrinsic assignments.

 - The construct must not contain any user defined function calls unless
   the function is ELEMENTAL.

Test cases : omp-workshare03.f90, omp-workshare04.f90, omp-workshare05.f90

Resolve test cases (omp-workshare01.f90 and omp-workshare02.f90) marked as XFAIL

Reviewed By: kiranchandramohan

Differential Revision: https://reviews.llvm.org/D93091

Added: 
    flang/test/Semantics/omp-workshare03.f90
    flang/test/Semantics/omp-workshare04.f90
    flang/test/Semantics/omp-workshare05.f90

Modified: 
    flang/lib/Semantics/check-omp-structure.cpp
    flang/lib/Semantics/check-omp-structure.h
    flang/test/Semantics/omp-workshare01.f90
    flang/test/Semantics/omp-workshare02.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index ff0db2c5182c..a9064490c352 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -37,6 +37,53 @@ namespace Fortran::semantics {
     CheckAllowed(llvm::omp::Y); \
   }
 
+// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
+// statements and the expressions enclosed in an OpenMP Workshare construct
+class OmpWorkshareBlockChecker {
+public:
+  OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
+      : context_{context}, source_{source} {}
+
+  template <typename T> bool Pre(const T &) { return true; }
+  template <typename T> void Post(const T &) {}
+
+  bool Pre(const parser::AssignmentStmt &assignment) {
+    const auto &var{std::get<parser::Variable>(assignment.t)};
+    const auto &expr{std::get<parser::Expr>(assignment.t)};
+    const auto *lhs{GetExpr(var)};
+    const auto *rhs{GetExpr(expr)};
+    Tristate isDefined{semantics::IsDefinedAssignment(
+        lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
+    if (isDefined == Tristate::Yes) {
+      context_.Say(expr.source,
+          "Defined assignment statement is not "
+          "allowed in a WORKSHARE construct"_err_en_US);
+    }
+    return true;
+  }
+
+  bool Pre(const parser::Expr &expr) {
+    if (const auto *e{GetExpr(expr)}) {
+      for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
+        const Symbol &root{GetAssociationRoot(symbol)};
+        if (IsFunction(root) &&
+            !(root.attrs().test(Attr::ELEMENTAL) ||
+                root.attrs().test(Attr::INTRINSIC))) {
+          context_.Say(expr.source,
+              "User defined non-ELEMENTAL function "
+              "'%s' is not allowed in a WORKSHARE construct"_err_en_US,
+              root.name());
+        }
+      }
+    }
+    return false;
+  }
+
+private:
+  SemanticsContext &context_;
+  parser::CharBlock source_;
+};
+
 bool OmpStructureChecker::HasInvalidWorksharingNesting(
     const parser::CharBlock &source, const OmpDirectiveSet &set) {
   // set contains all the invalid closely nested directives
@@ -149,6 +196,15 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
 
   PushContextAndClauseSets(beginDir.source, beginDir.v);
   CheckNoBranching(block, beginDir.v, beginDir.source);
+
+  switch (beginDir.v) {
+  case llvm::omp::OMPD_workshare:
+  case llvm::omp::OMPD_parallel_workshare:
+    CheckWorkshareBlockStmts(block, beginDir.source);
+    break;
+  default:
+    break;
+  }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
@@ -835,4 +891,82 @@ void OmpStructureChecker::GetSymbolsInObjectList(
   }
 }
 
+void OmpStructureChecker::CheckWorkshareBlockStmts(
+    const parser::Block &block, parser::CharBlock source) {
+  OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
+
+  for (auto it{block.begin()}; it != block.end(); ++it) {
+    if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
+        parser::Unwrap<parser::ForallStmt>(*it) ||
+        parser::Unwrap<parser::ForallConstruct>(*it) ||
+        parser::Unwrap<parser::WhereStmt>(*it) ||
+        parser::Unwrap<parser::WhereConstruct>(*it)) {
+      parser::Walk(*it, ompWorkshareBlockChecker);
+    } else if (const auto *ompConstruct{
+                   parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
+      if (const auto *ompAtomicConstruct{
+              std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
+        // Check if assignment statements in the enclosing OpenMP Atomic
+        // construct are allowed in the Workshare construct
+        parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
+      } else if (const auto *ompCriticalConstruct{
+                     std::get_if<parser::OpenMPCriticalConstruct>(
+                         &ompConstruct->u)}) {
+        // All the restrictions on the Workshare construct apply to the
+        // statements in the enclosing critical constructs
+        const auto &criticalBlock{
+            std::get<parser::Block>(ompCriticalConstruct->t)};
+        CheckWorkshareBlockStmts(criticalBlock, source);
+      } else {
+        // Check if OpenMP constructs enclosed in the Workshare construct are
+        // 'Parallel' constructs
+        auto currentDir{llvm::omp::Directive::OMPD_unknown};
+        const OmpDirectiveSet parallelDirSet{
+            llvm::omp::Directive::OMPD_parallel,
+            llvm::omp::Directive::OMPD_parallel_do,
+            llvm::omp::Directive::OMPD_parallel_sections,
+            llvm::omp::Directive::OMPD_parallel_workshare,
+            llvm::omp::Directive::OMPD_parallel_do_simd};
+
+        if (const auto *ompBlockConstruct{
+                std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
+          const auto &beginBlockDir{
+              std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
+          const auto &beginDir{
+              std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+          currentDir = beginDir.v;
+        } else if (const auto *ompLoopConstruct{
+                       std::get_if<parser::OpenMPLoopConstruct>(
+                           &ompConstruct->u)}) {
+          const auto &beginLoopDir{
+              std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
+          const auto &beginDir{
+              std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+          currentDir = beginDir.v;
+        } else if (const auto *ompSectionsConstruct{
+                       std::get_if<parser::OpenMPSectionsConstruct>(
+                           &ompConstruct->u)}) {
+          const auto &beginSectionsDir{
+              std::get<parser::OmpBeginSectionsDirective>(
+                  ompSectionsConstruct->t)};
+          const auto &beginDir{
+              std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
+          currentDir = beginDir.v;
+        }
+
+        if (!parallelDirSet.test(currentDir)) {
+          context_.Say(source,
+              "OpenMP constructs enclosed in WORKSHARE construct may consist "
+              "of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
+        }
+      }
+    } else {
+      context_.Say(source,
+          "The structured block in a WORKSHARE construct may consist of only "
+          "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
+          "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
+    }
+  }
+}
+
 } // namespace Fortran::semantics

diff  --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index b12cb09ae827..c9e90ef2d591 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -208,11 +208,11 @@ class OmpStructureChecker
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(
       const parser::OmpObjectList &, std::vector<const Symbol *> &);
-
   const parser::Name GetLoopIndex(const parser::DoConstruct *x);
   void SetLoopInfo(const parser::OpenMPLoopConstruct &x);
   void CheckIsLoopIvPartOfClause(
       llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
+  void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

diff  --git a/flang/test/Semantics/omp-workshare01.f90 b/flang/test/Semantics/omp-workshare01.f90
index 032c2db217f9..7396555ceeaf 100644
--- a/flang/test/Semantics/omp-workshare01.f90
+++ b/flang/test/Semantics/omp-workshare01.f90
@@ -1,6 +1,4 @@
 ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
-! XFAIL: *
-
 ! OpenMP Version 4.5
 ! 2.7.4 workshare Construct
 ! Invalid do construct inside !$omp workshare
@@ -9,14 +7,25 @@ subroutine workshare(aa, bb, cc, dd, ee, ff, n)
   integer n, i
   real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n)
 
+  !ERROR: The structured block in a WORKSHARE construct may consist of only SCALAR or ARRAY assignments, FORALL or WHERE statements, FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs
+  !ERROR: OpenMP constructs enclosed in WORKSHARE construct may consist of ATOMIC, CRITICAL or PARALLEL constructs only
   !$omp workshare
-  !ERROR: Unexpected do stmt inside !$omp workshare
   do i = 1, n
     print *, "omp workshare"
   end do
 
+  !$omp critical
+  !$omp single
   aa = bb
+  !$omp end single
+  !$omp end critical
+
+  !$omp parallel
+  !$omp single
   cc = dd
+  !$omp end single
+  !$omp end parallel
+
   ee = ff
   !$omp end workshare
 

diff  --git a/flang/test/Semantics/omp-workshare02.f90 b/flang/test/Semantics/omp-workshare02.f90
index f56d55cb6791..4f09269d536e 100644
--- a/flang/test/Semantics/omp-workshare02.f90
+++ b/flang/test/Semantics/omp-workshare02.f90
@@ -1,6 +1,4 @@
 ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
-! XFAIL: *
-
 ! OpenMP Version 4.5
 ! 2.7.4 workshare Construct
 ! The !omp workshare construct must not contain any user defined
@@ -8,22 +6,60 @@
 
 module my_mod
   contains
-  function my_func(n)
-    integer :: my_func(n, n)
+  integer function my_func()
     my_func = 10
   end function my_func
 end module my_mod
 
 subroutine workshare(aa, bb, cc, dd, ee, ff, n)
   use my_mod
-  integer n, i
-  real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n)
+  integer n, i, j
+  real aa(n), bb(n), cc(n), dd(n), ee(n), ff(n)
 
   !$omp workshare
-  !ERROR: Non-ELEMENTAL function is not allowed in !$omp workshare construct
-  aa = my_func(n)
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  aa = my_func()
   cc = dd
   ee = ff
+
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  where (aa .ne. my_func()) aa = bb * cc
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  where (dd .lt. 5) dd = aa * my_func()
+
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  where (aa .ge. my_func())
+    !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+    cc = aa + my_func()
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  elsewhere (aa .le. my_func())
+    !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+    cc = dd + my_func()
+  elsewhere
+    !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+    cc = ee + my_func()
+  end where
+
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  forall (j = 1:my_func()) aa(j) = aa(j) + bb(j)
+
+  forall (j = 1:10)
+    aa(j) = aa(j) + bb(j)
+
+    !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+    where (cc .le. j) cc = cc + my_func()
+  end forall
+
+  !$omp atomic update
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  j = j + my_func()
+
+  !$omp atomic capture
+  i = j
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
+  j = j - my_func()
+  !$omp end atomic
+
   !$omp end workshare
 
 end subroutine workshare

diff  --git a/flang/test/Semantics/omp-workshare03.f90 b/flang/test/Semantics/omp-workshare03.f90
new file mode 100644
index 000000000000..baebc0754f14
--- /dev/null
+++ b/flang/test/Semantics/omp-workshare03.f90
@@ -0,0 +1,32 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.4 workshare Construct
+! All array assignments, scalar assignments, and masked array assignments
+! must be intrinsic assignments.
+
+module defined_assign
+  interface assignment(=)
+    module procedure work_assign
+  end interface
+
+  contains
+    subroutine work_assign(a,b)
+      integer, intent(out) :: a
+      logical, intent(in) :: b(:)
+    end subroutine work_assign
+end module defined_assign
+
+program omp_workshare
+  use defined_assign
+
+  integer :: a, aa(10), bb(10)
+  logical :: l(10)
+  l = .TRUE.
+
+  !$omp workshare
+  !ERROR: Defined assignment statement is not allowed in a WORKSHARE construct
+  a = l
+  aa = bb
+  !$omp end workshare
+
+end program omp_workshare

diff  --git a/flang/test/Semantics/omp-workshare04.f90 b/flang/test/Semantics/omp-workshare04.f90
new file mode 100644
index 000000000000..63c91f75e8ff
--- /dev/null
+++ b/flang/test/Semantics/omp-workshare04.f90
@@ -0,0 +1,48 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.4 workshare Construct
+! Checks for OpenMP Workshare construct
+
+subroutine omp_workshare(aa, bb, cc, dd, ee, ff, n)
+  integer i, j, n, a(10), b(10)
+  integer, pointer :: p
+  integer, target :: t
+  real aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n)
+
+  !ERROR: The structured block in a WORKSHARE construct may consist of only SCALAR or ARRAY assignments, FORALL or WHERE statements, FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs
+  !$omp workshare
+  p => t
+
+  !$omp parallel
+  cc = dd
+  !$omp end parallel
+
+  !ERROR: OpenMP constructs enclosed in WORKSHARE construct may consist of ATOMIC, CRITICAL or PARALLEL constructs only
+  !$omp parallel workshare
+  !$omp single
+  ee = ff
+  !$omp end single
+  !$omp end parallel workshare
+
+  where (aa .ne. 0) cc = bb / aa
+
+  where (b .lt. 2) b = sum(a)
+
+  where (aa .ge. 2.0)
+    cc = aa + bb
+  elsewhere
+    cc = dd + ee
+  end where
+
+  forall (i = 1:10, n > i) a(i) = b(i)
+
+  forall (j = 1:10)
+    a(j) = a(j) + b(j)
+  end forall
+
+  !$omp atomic update
+  j = j + sum(a)
+
+  !$omp end workshare
+
+end subroutine omp_workshare

diff  --git a/flang/test/Semantics/omp-workshare05.f90 b/flang/test/Semantics/omp-workshare05.f90
new file mode 100644
index 000000000000..f131da852985
--- /dev/null
+++ b/flang/test/Semantics/omp-workshare05.f90
@@ -0,0 +1,60 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.4 workshare Construct
+! Checks for OpenMP Parallel constructs enclosed in Workshare constructs
+
+module workshare_mod
+  interface assignment(=)
+    module procedure work_assign
+  end interface
+
+  contains
+    subroutine work_assign(a,b)
+      integer, intent(out) :: a
+      logical, intent(in) :: b(:)
+    end subroutine work_assign
+
+    integer function my_func()
+      my_func = 10
+    end function my_func
+
+end module workshare_mod
+
+program omp_workshare
+  use workshare_mod
+
+  integer, parameter :: n = 10
+  integer :: i, j, a(10), b(10)
+  integer, pointer :: p
+  integer, target :: t
+  logical :: l(10)
+  real :: aa(n,n), bb(n,n), cc(n,n), dd(n,n), ee(n,n), ff(n,n)
+
+  !$omp workshare
+
+  !$omp parallel
+  p => t
+  a = l
+  !$omp single
+  ee = ff
+  !$omp end single
+  !$omp end parallel
+
+  !$omp parallel sections
+  !$omp section
+  aa = my_func()
+  !$omp end parallel sections
+
+  !$omp parallel do
+  do i = 1, 10
+    b(i) = my_func() + i
+  end do
+  !$omp end parallel do
+
+  !$omp parallel
+  where (dd .lt. 5) dd = aa * my_func()
+  !$omp end parallel
+
+  !$omp end workshare
+
+end program omp_workshare


        


More information about the flang-commits mailing list