[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

747

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

771–774

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

747

Thanks @kiranchandramohan Will handle the same.

747

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

771–774

@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

747

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

790

Nit: Remove empty line.

835–837

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

747

@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

747

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

790

Done

835–837

Done

[kiranchandramohan]

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

763

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?

807

Nit: Spelling ATOMIC

[praveen]

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

763

@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

763

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 *> &);
+  void CheckWorkshareBlockStmts(
+      const parser::Block &, parser::CharBlock);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

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

void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
 
   PushContextAndClauseSets(beginDir.source, beginDir.v);
 
   switch (beginDir.v) {
   case llvm::omp::OMPD_parallel:
     CheckNoBranching(block, llvm::omp::OMPD_parallel, beginDir.source);
     break;
+  case llvm::omp::OMPD_workshare:
+    CheckWorkshareBlockStmts(block, beginDir.source);
+    break;
   default:
     break;
   }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
   dirContext_.pop_back();
 }
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) {
+  for (auto it{block.begin()}; it != block.end(); ++it) {
+    if (const auto *assignment{parser::Unwrap<parser::AssignmentStmt>(*it)}) {
+      const auto &var{std::get<parser::Variable>(assignment->t)};
+      const auto &expr{std::get<parser::Expr>(assignment->t)};
+      if (const auto *e{GetExpr(expr)}) {
+        for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
+          if (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());
+            }
+          }
+        }
+      }
+
+      const auto *rhs{GetExpr(expr)};
+      const auto *lhs{GetExpr(var)};
+      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);
+      }
+    } else if (const auto *ompBlock{
+                   parser::Unwrap<parser::OpenMPBlockConstruct>(*it)}) {
+      const auto &beginBlockDir{
+          std::get<parser::OmpBeginBlockDirective>(ompBlock->t)};
+      const auto &beginDir{
+          std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+      if (beginDir.v != llvm::omp::Directive::OMPD_parallel) {
+        context_.Say(source,
+            "OpenMP '%s' construct is not allowed "
+            "in a WORKSHARE construct"_err_en_US,
+            parser::ToUpperCaseLetters(getDirectiveName(beginDir.v).str()));
+      }
+    } else if (!(parser::Unwrap<parser::ForallConstruct>(*it) ||
+                   parser::Unwrap<parser::ForallStmt>(*it) ||
+                   parser::Unwrap<parser::WhereConstruct>(*it) ||
+                   parser::Unwrap<parser::WhereStmt>(*it) ||
+                   parser::Unwrap<parser::OpenMPAtomicConstruct>(*it) ||
+                   parser::Unwrap<parser::OpenMPCriticalConstruct>(*it))) {
+      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
   !$omp workshare
-  !ERROR: Unexpected do stmt inside !$omp workshare
   do i = 1, n
     print *, "omp workshare"
   end do
 
   aa = bb
   cc = dd
   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)
     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)
 
   !$omp workshare
-  !ERROR: Non-ELEMENTAL function is not allowed in !$omp workshare construct
+  !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
   aa = my_func(n)
   cc = dd
   ee = ff
   !$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
+  !ERROR: OpenMP 'SINGLE' construct is not allowed in a WORKSHARE construct
+  !$omp workshare
+  p => t
+
+  !$omp parallel
+  cc = dd
+  !$omp end parallel
+
+  !$omp single
+  ee = ff
+  !$omp end single
+
+  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