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

[praveen]

Summary

Add Semantic checks for OpenMP 4.5 - 2.7.4 Workshare Construct

• The structured block in a worksahre 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.

Resolve related test cases marked XFAIL

[praveen]

Rebase and apply clang-format

[kiranchandramohan]

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

907

I think use of non-elemental function can be outside an assignment statement like in the where statement below.

program mn
  integer :: a(10) = (/1,2,3,4,5,6,7,8,9,10/)
  !$omp workshare
  where ( a .lt. f()) a = a + 5
  !$omp end workshare
contains
  integer function f()
    f = 5
  end function
end program

931–934

Is it better to use OmpStructureChecker::HasInvalidWorksharingNesting for handling this?

[praveen]

1. Handle uses of non-elemental functions in the workshare construct
2. Handle the nested where/forall constructs enclosed in the workshare construct
3. Apply the restrictions on workshare to OpenMP critical construct enclosed in workshare construct

[praveen]

@kiranchandramohan Updated the patch to handle all the checks on workshare construct . Since the WhereConstruct and ForallConstructs have nested WhereStmt/WhereConstructs and ForAllStmt/ForallConstructs , separate functions are added to handle the same recursively.

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

907

Thanks @kiranchandramohan Will handle the same.

907

@kiranchandramohan Modified the code to handle the same . Thanks!

931–934

@kiranchandramohan We would have to check for workshare directive and call OmpStructureChecker::HasInvalidWorksharingNesting for all the OpenMP Constructs.

Since the critical and atomic constructs are being checked here , thought it would be simpler to handle here.

Please let me know if we can have the check for other OpenMP constructs here or make use of HasInvalidWorksharingNesting in all the OpenMP Constructs

[kiranchandramohan]

Add a few tests to show that most restrictions do not apply inside a parallel construct nested inside a workshare construct.

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

907

There are probably more places (see example below) where user-defined are not allowed. I wonder whether a parse-tree walk would have been better for catching issues like these.

program mn
integer, parameter ::N = 100
real :: A(N,N), B(N,N)
!$omp workshare
FORALL(I = f():N, J = f():N, A(I, J) .NE. f()) B(I, J) = 1.0 / A(I, J)
!$omp end workshare
contains
 pure integer function f()
    f = 5
  end function
end program

950

Nit: Remove empty line.

995–997

Nit: Capitalize constructs like elsewhere.

[praveen]

@kiranchandramohan To make use of parse-tree walk to check all the assignments and expressions in OpenMP Workshare constructs , is it preferred to add a class in check-omp-structure.cpp specific for workshare or add a generic class in Semantics/tools.cpp to collect all the assignments and expressions and then iterate over all the assignments / expressions identified in the walk?

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

907

@kiranchandramohan Thanks for pointing this out . I had missed this check in forall statements and construct.

I do feel parse-tree walk would be better to catch all the assignments and Expressions instead of multiple functions for each statement / construct.

[praveen]

Use parse-tree walk to check the validity of assignments and expressions in workshare construct .

[praveen]

In D93091#2495365, @kiranchandramohan wrote:

Add a few tests to show that most restrictions do not apply inside a parallel construct nested inside a workshare construct.

@kiranchandramohan Added a class to make use of parse-tree walk for identifying all the assignments and expressions in workshare construct . Added tests with parallel constructs inside a workshare construct.

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

907

Have added a new class to use parse-tree walk to catch all the assignments and Expressions.

950

Done

995–997

Done

[kiranchandramohan]

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

923

Should this be set to some invalid value to avoid a stale value matching, since only block, loop and sections construct is handled for setting the currentDir?

967

Nit: Spelling ATOMIC

[praveen]

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

923

@kiranchandramohan Can the currentDir be set to llvm::omp::Directive::OMPD_unknown or is it used for a specific purpose ?

[kiranchandramohan]

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

923

I think it is OK to use.

[praveen]

Address review comments

[kiranchandramohan]

LGTM.

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

private:
   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);
   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_

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

#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
   }
 
 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
   void OmpStructureChecker::Enter(const parser::X &) { \
     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
   // for the given directive (`source` here)
   if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) {
     context_.Say(source,
         "A worksharing region may not be closely nested inside a "
         "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   // checks.
   if (beginDir.v == llvm::omp::Directive::OMPD_single) {
     HasInvalidWorksharingNesting(
         beginDir.source, {llvm::omp::Directive::OMPD_do});
   }
 
   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 &) {
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
   const auto &beginSectionsDir{
if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
         } else {
           symbols.emplace_back(&symbol->GetUltimate());
         }
       }
     }
   }
 }
 
+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

flang/test/Semantics/omp-workshare01.f90

 ! 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
 
 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
 
 end subroutine workshare

flang/test/Semantics/omp-workshare02.f90

 ! 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
 ! function calls unless the function is ELEMENTAL.
 
 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

flang/test/Semantics/omp-workshare03.f90

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

flang/test/Semantics/omp-workshare04.f90

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

flang/test/Semantics/omp-workshare05.f90

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