[flang][OpenMP] Parse bind clause for loop direcitve. (#113662)

Adds parsing for the `bind` clause. The clause was already part of the
`loop` direcitve's definition but parsing was still missing.

Author: ergawy

flang/include/flang/Parser/dump-parse-tree.h

@@ -555,6 +555,8 @@ class ParseTreeDumper {
   NODE_ENUM(OmpGrainsizeClause, Prescriptiveness)
   NODE(parser, OmpNumTasksClause)
   NODE_ENUM(OmpNumTasksClause, Prescriptiveness)
+  NODE(parser, OmpBindClause)
+  NODE_ENUM(OmpBindClause, Type)
   NODE(parser, OmpProcBindClause)
   NODE_ENUM(OmpProcBindClause, Type)
   NODE_ENUM(OmpReductionClause, ReductionModifier)

flang/include/flang/Parser/parse-tree.h

@@ -3778,6 +3778,13 @@ struct OmpNumTasksClause {
 // update-clause -> UPDATE(task-dependence-type)    // since 5.0
 WRAPPER_CLASS(OmpUpdateClause, OmpTaskDependenceType);
 
+// OMP 5.2 11.7.1 bind-clause ->
+//                  BIND( PARALLEL | TEAMS | THREAD )
+struct OmpBindClause {
+  ENUM_CLASS(Type, Parallel, Teams, Thread)
+  WRAPPER_CLASS_BOILERPLATE(OmpBindClause, Type);
+};
+
 // OpenMP Clauses
 struct OmpClause {
   UNION_CLASS_BOILERPLATE(OmpClause);

flang/include/flang/Semantics/openmp-directive-sets.h

@@ -169,6 +169,7 @@ static const OmpDirectiveSet topTeamsSet{
     Directive::OMPD_teams_distribute_parallel_do,
     Directive::OMPD_teams_distribute_parallel_do_simd,
     Directive::OMPD_teams_distribute_simd,
+    Directive::OMPD_teams_loop,
 };
 
 static const OmpDirectiveSet allTeamsSet{
@@ -366,6 +367,7 @@ static const OmpDirectiveSet nestedTeamsAllowedSet{
     Directive::OMPD_distribute_parallel_do,
     Directive::OMPD_distribute_parallel_do_simd,
     Directive::OMPD_distribute_simd,
+    Directive::OMPD_loop,
     Directive::OMPD_parallel,
     Directive::OMPD_parallel_do,
     Directive::OMPD_parallel_do_simd,

flang/lib/Parser/openmp-parsers.cpp

@@ -495,6 +495,12 @@ TYPE_PARSER(construct<OmpLastprivateClause>(
         pure(OmpLastprivateClause::LastprivateModifier::Conditional) / ":"),
     Parser<OmpObjectList>{}))
 
+// OMP 5.2 11.7.1 BIND ( PARALLEL | TEAMS | THREAD )
+TYPE_PARSER(construct<OmpBindClause>(
+    "PARALLEL" >> pure(OmpBindClause::Type::Parallel) ||
+    "TEAMS" >> pure(OmpBindClause::Type::Teams) ||
+    "THREAD" >> pure(OmpBindClause::Type::Thread)))
+
 TYPE_PARSER(
     "ACQUIRE" >> construct<OmpClause>(construct<OmpClause::Acquire>()) ||
     "ACQ_REL" >> construct<OmpClause>(construct<OmpClause::AcqRel>()) ||
@@ -509,6 +515,8 @@ TYPE_PARSER(
     "ATOMIC_DEFAULT_MEM_ORDER" >>
         construct<OmpClause>(construct<OmpClause::AtomicDefaultMemOrder>(
             parenthesized(Parser<OmpAtomicDefaultMemOrderClause>{}))) ||
+    "BIND" >> construct<OmpClause>(construct<OmpClause::Bind>(
+                  parenthesized(Parser<OmpBindClause>{}))) ||
     "COLLAPSE" >> construct<OmpClause>(construct<OmpClause::Collapse>(
                       parenthesized(scalarIntConstantExpr))) ||
     "COPYIN" >> construct<OmpClause>(construct<OmpClause::Copyin>(
@@ -697,6 +705,7 @@ TYPE_PARSER(sourced(construct<OmpLoopDirective>(first(
     "TEAMS DISTRIBUTE SIMD" >>
         pure(llvm::omp::Directive::OMPD_teams_distribute_simd),
     "TEAMS DISTRIBUTE" >> pure(llvm::omp::Directive::OMPD_teams_distribute),
+    "TEAMS LOOP" >> pure(llvm::omp::Directive::OMPD_teams_loop),
     "TILE" >> pure(llvm::omp::Directive::OMPD_tile),
     "UNROLL" >> pure(llvm::omp::Directive::OMPD_unroll)))))
 

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

@@ -420,13 +420,47 @@ void OmpStructureChecker::HasInvalidDistributeNesting(
         "region."_err_en_US);
   }
 }
+void OmpStructureChecker::HasInvalidLoopBinding(
+    const parser::OpenMPLoopConstruct &x) {
+  const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+  const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+
+  auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
+    const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+    for (const auto &clause : clauseList.v) {
+      if (const auto *bindClause{
+              std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
+        if (bindClause->v.v != parser::OmpBindClause::Type::Teams) {
+          context_.Say(beginDir.source, msg);
+        }
+      }
+    }
+  };
+
+  if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
+      CurrentDirectiveIsNested() &&
+      OmpDirectiveSet{llvm::omp::OMPD_teams, llvm::omp::OMPD_target_teams}.test(
+          GetContextParent().directive)) {
+    teamsBindingChecker(
+        "`BIND(TEAMS)` must be specified since the `LOOP` region is "
+        "strictly nested inside a `TEAMS` region."_err_en_US);
+  }
+
+  if (OmpDirectiveSet{
+          llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
+          .test(beginDir.v)) {
+    teamsBindingChecker(
+        "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
+        "combined with a `TEAMS` construct."_err_en_US);
+  }
+}
 
 void OmpStructureChecker::HasInvalidTeamsNesting(
     const llvm::omp::Directive &dir, const parser::CharBlock &source) {
   if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
     context_.Say(source,
-        "Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly "
-        "nested inside `TEAMS` region."_err_en_US);
+        "Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "
+        "strictly nested inside `TEAMS` region."_err_en_US);
   }
 }
 
@@ -589,6 +623,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
   CheckLoopItrVariableIsInt(x);
   CheckAssociatedLoopConstraints(x);
   HasInvalidDistributeNesting(x);
+  HasInvalidLoopBinding(x);
   if (CurrentDirectiveIsNested() &&
       llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
     HasInvalidTeamsNesting(beginDir.v, beginDir.source);

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

@@ -151,6 +151,7 @@ class OmpStructureChecker
   void HasInvalidTeamsNesting(
       const llvm::omp::Directive &dir, const parser::CharBlock &source);
   void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x);
+  void HasInvalidLoopBinding(const parser::OpenMPLoopConstruct &x);
   // specific clause related
   bool ScheduleModifierHasType(const parser::OmpScheduleClause &,
       const parser::OmpScheduleModifierType::ModType &);

flang/lib/Semantics/resolve-directives.cpp

@@ -1671,6 +1671,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
   case llvm::omp::Directive::OMPD_teams_distribute_simd:
+  case llvm::omp::Directive::OMPD_teams_loop:
   case llvm::omp::Directive::OMPD_tile:
   case llvm::omp::Directive::OMPD_unroll:
     PushContext(beginDir.source, beginDir.v);

flang/test/Parser/OpenMP/target-loop-unparse.f90

@@ -1,6 +1,8 @@
+! RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=50 %s | \
+! RUN:   FileCheck --ignore-case %s
 
-! RUN: %flang_fc1 -fdebug-unparse -fopenmp %s | FileCheck --ignore-case %s
-! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp %s | FileCheck --check-prefix="PARSE-TREE" %s
+! RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=50 %s | \
+! RUN:   FileCheck --check-prefix="PARSE-TREE" %s
 
 ! Check for parsing of loop directive
 
@@ -14,6 +16,16 @@ subroutine test_loop
    j = j + 1
   end do
   !$omp end loop
+
+  !PARSE-TREE: OmpBeginLoopDirective
+  !PARSE-TREE-NEXT: OmpLoopDirective -> llvm::omp::Directive = loop
+  !PARSE-TREE-NEXT: OmpClauseList -> OmpClause -> Bind -> OmpBindClause -> Type = Thread
+  !CHECK: !$omp loop
+  !$omp loop bind(thread)
+  do i=1,10
+   j = j + 1
+  end do
+  !$omp end loop
 end subroutine
 
 subroutine test_target_loop

flang/test/Semantics/OpenMP/loop-bind.f90

@@ -0,0 +1,33 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50
+
+! OpenMP Version 5.0
+! Check OpenMP construct validity for the following directives:
+! 11.7 Loop directive
+
+program main
+  integer :: i, x
+
+  !$omp teams 
+  !ERROR: `BIND(TEAMS)` must be specified since the `LOOP` region is strictly nested inside a `TEAMS` region.
+  !$omp loop bind(thread)
+  do i = 1, 10
+    x = x + 1
+  end do
+  !$omp end loop
+  !$omp end teams
+
+  !ERROR: `BIND(TEAMS)` must be specified since the `LOOP` directive is combined with a `TEAMS` construct.
+  !$omp target teams loop bind(thread)
+  do i = 1, 10
+    x = x + 1
+  end do
+  !$omp end target teams loop
+
+  !ERROR: `BIND(TEAMS)` must be specified since the `LOOP` directive is combined with a `TEAMS` construct.
+  !$omp teams loop bind(thread)
+  do i = 1, 10
+    x = x + 1
+  end do
+  !$omp end teams loop
+
+end program main

flang/test/Semantics/OpenMP/nested-distribute.f90

@@ -21,7 +21,7 @@ program main
 
   !$omp teams
    do i = 1, N
-      !ERROR: Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region.
+      !ERROR: Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be strictly nested inside `TEAMS` region.
       !$omp task
       do k = 1, N
          a = 3.14
@@ -50,7 +50,7 @@ program main
   !$omp end parallel
 
   !$omp teams
-   !ERROR: Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region.
+   !ERROR: Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be strictly nested inside `TEAMS` region.
    !$omp target
       !ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
       !$omp distribute 
@@ -82,7 +82,7 @@ program main
   !$omp end target teams
 
   !$omp teams 
-      !ERROR: Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly nested inside `TEAMS` region.
+      !ERROR: Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be strictly nested inside `TEAMS` region.
       !$omp task
       do k = 1,10
          print *, "hello"