[flang][OpenMP] Semantic checks for DOACROSS clause

Keep track of loop constructs and OpenMP loop constructs that have
been entered. Use the information to validate the variables in the
SINK loop iteration vector.

Author: kparzysz

flang/lib/Lower/OpenMP/Clauses.cpp

@@ -574,20 +574,17 @@ Defaultmap make(const parser::OmpClause::Defaultmap &inp,
                      /*VariableCategory=*/maybeApply(convert2, t1)}};
 }
 
-Depend make(const parser::OmpClause::Depend &inp,
-            semantics::SemanticsContext &semaCtx) {
-  // inp.v -> parser::OmpDependClause
-  using wrapped = parser::OmpDependClause;
-  using Variant = decltype(Depend::u);
+Doacross makeDoacross(const parser::OmpDoacross &doa,
+                      semantics::SemanticsContext &semaCtx) {
   // Iteration is the equivalent of parser::OmpIteration
   using Iteration = Doacross::Vector::value_type; // LoopIterationT
 
-  auto visitSource = [&](const parser::OmpDoacross::Source &) -> Variant {
+  auto visitSource = [&](const parser::OmpDoacross::Source &) {
     return Doacross{{/*DependenceType=*/Doacross::DependenceType::Source,
                      /*Vector=*/{}}};
   };
 
-  auto visitSink = [&](const parser::OmpDoacross::Sink &s) -> Variant {
+  auto visitSink = [&](const parser::OmpDoacross::Sink &s) {
     using IterOffset = parser::OmpIterationOffset;
     auto convert2 = [&](const parser::OmpIteration &v) {
       auto &t0 = std::get<parser::Name>(v.t);
@@ -605,6 +602,15 @@ Depend make(const parser::OmpClause::Depend &inp,
                      /*Vector=*/makeList(s.v.v, convert2)}};
   };
 
+  return common::visit(common::visitors{visitSink, visitSource}, doa.u);
+}
+
+Depend make(const parser::OmpClause::Depend &inp,
+            semantics::SemanticsContext &semaCtx) {
+  // inp.v -> parser::OmpDependClause
+  using wrapped = parser::OmpDependClause;
+  using Variant = decltype(Depend::u);
+
   auto visitTaskDep = [&](const wrapped::TaskDep &s) -> Variant {
     auto &t0 = std::get<std::optional<parser::OmpIteratorModifier>>(s.t);
     auto &t1 = std::get<parser::OmpTaskDependenceType>(s.t);
@@ -617,11 +623,11 @@ Depend make(const parser::OmpClause::Depend &inp,
                             /*LocatorList=*/makeObjects(t2, semaCtx)}};
   };
 
-  return Depend{Fortran::common::visit( //
+  return Depend{common::visit( //
       common::visitors{
           // Doacross
           [&](const parser::OmpDoacross &s) -> Variant {
-            return common::visit(common::visitors{visitSink, visitSource}, s.u);
+            return makeDoacross(s, semaCtx);
           },
           // Depend::TaskDep
           visitTaskDep,
@@ -692,8 +698,8 @@ DistSchedule make(const parser::OmpClause::DistSchedule &inp,
 
 Doacross make(const parser::OmpClause::Doacross &inp,
               semantics::SemanticsContext &semaCtx) {
-  // inp -> empty
-  llvm_unreachable("Empty: doacross");
+  // inp.v -> OmpDoacrossClause
+  return makeDoacross(inp.v.v, semaCtx);
 }
 
 // DynamicAllocators: empty

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

@@ -541,6 +541,7 @@ void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
 }
 
 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
+  loopStack_.push_back(&x);
   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
 
@@ -933,11 +934,19 @@ void OmpStructureChecker::CheckDistLinear(
   }
 }
 
-void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
+void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
   if (llvm::omp::allSimdSet.test(GetContext().directive)) {
     ExitDirectiveNest(SIMDNest);
   }
   dirContext_.pop_back();
+
+  assert(!loopStack_.empty() && "Expecting non-empty loop stack");
+  const LoopConstruct &top = loopStack_.back();
+#ifndef NDEBUG
+  auto *loopc = std::get_if<const parser::OpenMPLoopConstruct *>(&top);
+  assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
+#endif
+  loopStack_.pop_back();
 }
 
 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
@@ -1068,8 +1077,7 @@ void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
 void OmpStructureChecker::ChecksOnOrderedAsBlock() {
   if (FindClause(llvm::omp::Clause::OMPC_depend)) {
     context_.Say(GetContext().clauseSource,
-        "DEPEND(*) clauses are not allowed when ORDERED construct is a block"
-        " construct with an ORDERED region"_err_en_US);
+        "DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);
     return;
   }
 
@@ -1618,7 +1626,8 @@ void OmpStructureChecker::CheckBarrierNesting(
 void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
   if (FindClause(llvm::omp::Clause::OMPC_threads) ||
       FindClause(llvm::omp::Clause::OMPC_simd)) {
-    context_.Say(GetContext().clauseSource,
+    context_.Say(
+        GetContext().clauseSource,
         "THREADS, SIMD clauses are not allowed when ORDERED construct is a "
         "standalone construct with no ORDERED region"_err_en_US);
   }
@@ -1645,8 +1654,9 @@ void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
     }
   };
 
-  auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_depend);
-  for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
+  // Visit the DEPEND and DOACROSS clauses.
+  auto depClauses = FindClauses(llvm::omp::Clause::OMPC_depend);
+  for (auto itr = depClauses.first; itr != depClauses.second; ++itr) {
     const auto &dependClause{
         std::get<parser::OmpClause::Depend>(itr->second->u)};
     if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
@@ -1656,6 +1666,11 @@ void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
           "Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
     }
   }
+  auto doaClauses = FindClauses(llvm::omp::Clause::OMPC_doacross);
+  for (auto itr = doaClauses.first; itr != doaClauses.second; ++itr) {
+    auto &doaClause{std::get<parser::OmpClause::Doacross>(itr->second->u)};
+    visitDoacross(doaClause.v.v, itr->second->source);
+  }
 
   bool isNestedInDoOrderedWithPara{false};
   if (CurrentDirectiveIsNested() &&
@@ -1693,13 +1708,18 @@ void OmpStructureChecker::CheckOrderedDependClause(
       }
     }
   };
-  auto clauseAll{FindClauses(llvm::omp::Clause::OMPC_depend)};
-  for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
+  auto depClauses{FindClauses(llvm::omp::Clause::OMPC_depend)};
+  for (auto itr = depClauses.first; itr != depClauses.second; ++itr) {
     auto &dependClause{std::get<parser::OmpClause::Depend>(itr->second->u)};
     if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
       visitDoacross(*doAcross, itr->second->source);
     }
   }
+  auto doaClauses = FindClauses(llvm::omp::Clause::OMPC_doacross);
+  for (auto itr = doaClauses.first; itr != doaClauses.second; ++itr) {
+    auto &doaClause{std::get<parser::OmpClause::Doacross>(itr->second->u)};
+    visitDoacross(doaClause.v.v, itr->second->source);
+  }
 }
 
 void OmpStructureChecker::CheckTargetUpdate() {
@@ -2677,7 +2697,6 @@ CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
 CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
 CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
 CHECK_SIMPLE_CLAUSE(CancellationConstructType, OMPC_cancellation_construct_type)
-CHECK_SIMPLE_CLAUSE(Doacross, OMPC_doacross)
 CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
 CHECK_SIMPLE_CLAUSE(OmpxBare, OMPC_ompx_bare)
 CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
@@ -3458,6 +3477,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
       "Unexpected alternative in update clause");
 
   if (doaDep) {
+    CheckDoacross(*doaDep);
     CheckDependenceType(doaDep->GetDepType());
   } else {
     CheckTaskDependenceType(taskDep->GetTaskDepType());
@@ -3537,6 +3557,93 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {
+  CheckAllowedClause(llvm::omp::Clause::OMPC_doacross);
+  CheckDoacross(x.v.v);
+}
+
+void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {
+  if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {
+    // Nothing to check here.
+    return;
+  }
+
+  // Process SINK dependence type. SINK may only appear in an ORDER construct,
+  // which references a prior ORDERED(n) clause on a DO or SIMD construct
+  // that marks the top of the loop nest.
+
+  auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};
+  const std::list<parser::OmpIteration> &vec{sink.v.v};
+
+  // Check if the variables in the iteration vector are unique.
+  struct Less {
+    bool operator()(
+        const parser::OmpIteration *a, const parser::OmpIteration *b) const {
+      auto namea{std::get<parser::Name>(a->t)};
+      auto nameb{std::get<parser::Name>(b->t)};
+      assert(namea.symbol && nameb.symbol && "Unresolved symbols");
+      // The non-determinism of the "<" doesn't matter, we only care about
+      // equality, i.e.  a == b  <=>  !(a < b) && !(b < a)
+      return reinterpret_cast<uintptr_t>(namea.symbol) <
+          reinterpret_cast<uintptr_t>(nameb.symbol);
+    }
+  };
+  if (auto *duplicate{FindDuplicateEntry<parser::OmpIteration, Less>(vec)}) {
+    auto name{std::get<parser::Name>(duplicate->t)};
+    context_.Say(name.source,
+        "Duplicate variable '%s' in the iteration vector"_err_en_US,
+        name.ToString());
+  }
+
+  // Check if the variables in the iteration vector are induction variables.
+  // Ignore any mismatch between the size of the iteration vector and the
+  // number of DO constructs on the stack. This is checked elsewhere.
+
+  auto GetLoopDirective{[](const parser::OpenMPLoopConstruct &x) {
+    auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
+    return std::get<parser::OmpLoopDirective>(begin.t).v;
+  }};
+  auto GetLoopClauses{[](const parser::OpenMPLoopConstruct &x)
+                          -> const std::list<parser::OmpClause> & {
+    auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
+    return std::get<parser::OmpClauseList>(begin.t).v;
+  }};
+
+  std::set<const Symbol *> inductionVars;
+  for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {
+    if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {
+      // Do-construct, collect the induction variable.
+      if (auto &control{(*doc)->GetLoopControl()}) {
+        if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {
+          inductionVars.insert(b->name.thing.symbol);
+        }
+      }
+    } else {
+      // Omp-loop-construct, check if it's do/simd with an ORDERED clause.
+      auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};
+      assert(loopc && "Expecting OpenMPLoopConstruct");
+      llvm::omp::Directive loopDir{GetLoopDirective(**loopc)};
+      if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {
+        auto IsOrdered{[](const parser::OmpClause &c) {
+          return c.Id() == llvm::omp::OMPC_ordered;
+        }};
+        // If it has ORDERED clause, stop the traversal.
+        if (llvm::any_of(GetLoopClauses(**loopc), IsOrdered)) {
+          break;
+        }
+      }
+    }
+  }
+  for (const parser::OmpIteration &iter : vec) {
+    auto &name{std::get<parser::Name>(iter.t)};
+    if (!inductionVars.count(name.symbol)) {
+      context_.Say(name.source,
+          "The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,
+          name.ToString());
+    }
+  }
+}
+
 void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
     SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
   if (context_.ShouldWarn(common::UsageWarning::Portability)) {
@@ -4291,6 +4398,22 @@ void OmpStructureChecker::Enter(
   CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);
 }
 
+void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
+  Base::Enter(x);
+  loopStack_.push_back(&x);
+}
+
+void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
+  assert(!loopStack_.empty() && "Expecting non-empty loop stack");
+  const LoopConstruct &top = loopStack_.back();
+#ifndef NDEBUG
+  auto *doc = std::get_if<const parser::DoConstruct *>(&top);
+  assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
+#endif
+  loopStack_.pop_back();
+  Base::Leave(x);
+}
+
 void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
   CheckAllowedClause(clause);
 

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

@@ -60,6 +60,9 @@ class OmpStructureChecker
     : public DirectiveStructureChecker<llvm::omp::Directive, llvm::omp::Clause,
           parser::OmpClause, llvm::omp::Clause_enumSize> {
 public:
+  using Base = DirectiveStructureChecker<llvm::omp::Directive,
+      llvm::omp::Clause, parser::OmpClause, llvm::omp::Clause_enumSize>;
+
   OmpStructureChecker(SemanticsContext &context)
       : DirectiveStructureChecker(context,
 #define GEN_FLANG_DIRECTIVE_CLAUSE_MAP
@@ -131,6 +134,9 @@ class OmpStructureChecker
   void Enter(const parser::OmpAtomicCapture &);
   void Leave(const parser::OmpAtomic &);
 
+  void Enter(const parser::DoConstruct &);
+  void Leave(const parser::DoConstruct &);
+
 #define GEN_FLANG_CLAUSE_CHECK_ENTER
 #include "llvm/Frontend/OpenMP/OMP.inc"
 
@@ -156,13 +162,19 @@ class OmpStructureChecker
       const parser::OmpScheduleModifierType::ModType &);
   void CheckAllowedMapTypes(const parser::OmpMapClause::Type &,
       const std::list<parser::OmpMapClause::Type> &);
-  template <typename T> const T *FindDuplicateEntry(const std::list<T> &);
   llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
 
+  template <typename T> struct DefaultLess {
+    bool operator()(const T *a, const T *b) const { return *a < *b; }
+  };
+  template <typename T, typename Less = DefaultLess<T>>
+  const T *FindDuplicateEntry(const std::list<T> &);
+
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
+  void CheckDoacross(const parser::OmpDoacross &doa);
   bool IsDataRefTypeParamInquiry(const parser::DataRef *dataRef);
   void CheckIsVarPartOfAnotherVar(const parser::CharBlock &source,
       const parser::OmpObjectList &objList, llvm::StringRef clause = "");
@@ -254,20 +266,21 @@ class OmpStructureChecker
   int directiveNest_[LastType + 1] = {0};
 
   SymbolSourceMap deferredNonVariables_;
+
+  using LoopConstruct = std::variant<const parser::DoConstruct *,
+      const parser::OpenMPLoopConstruct *>;
+  std::vector<LoopConstruct> loopStack_;
 };
 
-template <typename T>
+template <typename T, typename Less>
 const T *OmpStructureChecker::FindDuplicateEntry(const std::list<T> &list) {
   // Add elements of the list to a set. If the insertion fails, return
   // the address of the failing element.
 
   // The objects of type T may not be copyable, so add their addresses
   // to the set. The set will need to compare the actual objects, so
   // the custom comparator is provided.
-  struct less {
-    bool operator()(const T *a, const T *b) const { return *a < *b; }
-  };
-  std::set<const T *, less> uniq;
+  std::set<const T *, Less> uniq;
 
   for (const T &item : list) {
     if (!uniq.insert(&item).second) {

flang/lib/Semantics/resolve-directives.cpp

@@ -554,8 +554,16 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   }
 
   void Post(const parser::OmpIteration &x) {
-    const auto &name{std::get<parser::Name>(x.t)};
-    ResolveName(&name);
+    if (const auto &name{std::get<parser::Name>(x.t)}; !name.symbol) {
+      auto *symbol{currScope().FindSymbol(name.source)};
+      if (!symbol) {
+        // OmpIteration must use an existing object. If there isn't one,
+        // create a fake one and flag an error later.
+        symbol = &currScope().MakeSymbol(
+            name.source, Attrs{}, EntityDetails(/*isDummy=*/true));
+      }
+      Resolve(name, symbol);
+    }
   }
 
   bool Pre(const parser::OmpClause::UseDevicePtr &x) {