Add Semantic check for Flang OpenMP 4.5 - 2.7.1 Do Loop restrictions.

Implementation of Do loop iteration variable check, Do while loop check, Do loop cycle restrictions. Also to check whether the ordered clause is present on the loop construct if any ordered region ever binds to a loop region arising from the loop construct. Files: check-omp-structure.h check-omp-structure.cpp resolve-directives.cpp Testcases: omp-do06-positivecases.f90 omp-do06.f90 omp-do08.f90 omp-do09.f90 omp-do10.f90 omp-do11.f90 omp-do12.f90 omp-do13.f90 omp-do14.f90 omp-do15.f90 omp-do16.f90 omp-do17.f90 Reviewed by: Kiran Chandramohan @kiranchandramohan , Valentin Clement @clementval Differential Revision: https://reviews.llvm.org/D92732
llvm · Feb 15, 2021 · 20e3a6c · 20e3a6c
1 parent b9d3234
commit 20e3a6c
Show file tree

Hide file tree

Showing 15 changed files with 997 additions and 32 deletions.
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
@@ -84,6 +84,49 @@ class OmpWorkshareBlockChecker {
   parser::CharBlock source_;
 };
 
+class OmpCycleChecker {
+public:
+  OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel)
+      : context_{context}, cycleLevel_{cycleLevel} {}
+
+  template <typename T> bool Pre(const T &) { return true; }
+  template <typename T> void Post(const T &) {}
+
+  bool Pre(const parser::DoConstruct &dc) {
+    cycleLevel_--;
+    const auto &labelName{std::get<0>(std::get<0>(dc.t).statement.t)};
+    if (labelName) {
+      labelNamesandLevels_.emplace(labelName.value().ToString(), cycleLevel_);
+    }
+    return true;
+  }
+
+  bool Pre(const parser::CycleStmt &cyclestmt) {
+    std::map<std::string, std::int64_t>::iterator it;
+    bool err{false};
+    if (cyclestmt.v) {
+      it = labelNamesandLevels_.find(cyclestmt.v->source.ToString());
+      err = (it != labelNamesandLevels_.end() && it->second > 0);
+    }
+    if (cycleLevel_ > 0 || err) {
+      context_.Say(*cycleSource_,
+          "CYCLE statement to non-innermost associated loop of an OpenMP DO construct"_err_en_US);
+    }
+    return true;
+  }
+
+  bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
+    cycleSource_ = &actionstmt.source;
+    return true;
+  }
+
+private:
+  SemanticsContext &context_;
+  const parser::CharBlock *cycleSource_;
+  std::int64_t cycleLevel_;
+  std::map<std::string, std::int64_t> labelNamesandLevels_;
+};
+
 bool OmpStructureChecker::HasInvalidWorksharingNesting(
     const parser::CharBlock &source, const OmpDirectiveSet &set) {
   // set contains all the invalid closely nested directives
@@ -147,6 +190,9 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
     const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
     CheckNoBranching(doBlock, beginDir.v, beginDir.source);
   }
+  CheckDoWhile(x);
+  CheckLoopItrVariableIsInt(x);
+  CheckCycleConstraints(x);
 }
 const parser::Name OmpStructureChecker::GetLoopIndex(
     const parser::DoConstruct *x) {
@@ -163,6 +209,85 @@ void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
     }
   }
 }
+void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) {
+  const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+  const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+  if (beginDir.v == llvm::omp::Directive::OMPD_do) {
+    if (const auto &doConstruct{
+            std::get<std::optional<parser::DoConstruct>>(x.t)}) {
+      if (doConstruct.value().IsDoWhile()) {
+        const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>(
+            doConstruct.value().t)};
+        context_.Say(doStmt.source,
+            "The DO loop cannot be a DO WHILE with DO directive."_err_en_US);
+      }
+    }
+  }
+}
+
+void OmpStructureChecker::CheckLoopItrVariableIsInt(
+    const parser::OpenMPLoopConstruct &x) {
+  if (const auto &loopConstruct{
+          std::get<std::optional<parser::DoConstruct>>(x.t)}) {
+
+    for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
+      if (loop->IsDoNormal()) {
+        const parser::Name &itrVal{GetLoopIndex(loop)};
+        if (itrVal.symbol) {
+          const auto *type{itrVal.symbol->GetType()};
+          if (!type->IsNumeric(TypeCategory::Integer)) {
+            context_.Say(itrVal.source,
+                "The DO loop iteration"
+                " variable must be of the type integer."_err_en_US,
+                itrVal.ToString());
+          }
+        }
+      }
+      // Get the next DoConstruct if block is not empty.
+      const auto &block{std::get<parser::Block>(loop->t)};
+      const auto it{block.begin()};
+      loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
+                               : nullptr;
+    }
+  }
+}
+
+std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
+    const parser::OpenMPLoopConstruct &x) {
+  const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+  const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
+  std::int64_t orderedCollapseLevel{1};
+  std::int64_t orderedLevel{0};
+  std::int64_t collapseLevel{0};
+
+  for (const auto &clause : clauseList.v) {
+    if (const auto *collapseClause{
+            std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
+      if (const auto v{GetIntValue(collapseClause->v)}) {
+        collapseLevel = *v;
+      }
+    }
+    if (const auto *orderedClause{
+            std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
+      if (const auto v{GetIntValue(orderedClause->v)}) {
+        orderedLevel = *v;
+      }
+    }
+  }
+  if (orderedLevel >= collapseLevel) {
+    orderedCollapseLevel = orderedLevel;
+  } else {
+    orderedCollapseLevel = collapseLevel;
+  }
+  return orderedCollapseLevel;
+}
+
+void OmpStructureChecker::CheckCycleConstraints(
+    const parser::OpenMPLoopConstruct &x) {
+  std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
+  OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel};
+  parser::Walk(x, ompCycleChecker);
+}
 
 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
   dirContext_.pop_back();
@@ -199,6 +324,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
     HasInvalidWorksharingNesting(
         beginDir.source, {llvm::omp::Directive::OMPD_do});
   }
+  CheckIfDoOrderedClause(beginDir);
 
   PushContextAndClauseSets(beginDir.source, beginDir.v);
   CheckNoBranching(block, beginDir.v, beginDir.source);
@@ -213,6 +339,18 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   }
 }
 
+void OmpStructureChecker::CheckIfDoOrderedClause(
+    const parser::OmpBlockDirective &blkDirective) {
+  if (blkDirective.v == llvm::omp::OMPD_ordered) {
+    if (!FindClause(llvm::omp::Clause::OMPC_ordered)) {
+      context_.Say(blkDirective.source,
+          "The ORDERED clause must be present on the loop"
+          " construct if any ORDERED region ever binds"
+          " to a loop region arising from the loop construct."_err_en_US);
+    }
+  }
+}
+
 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
   dirContext_.pop_back();
 }
@@ -583,7 +721,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
 
 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
     const parser::OmpObjectList &objList) {
-
   for (const auto &ompObject : objList.v) {
     std::visit(
         common::visitors{

diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
@@ -165,6 +165,12 @@ class OmpStructureChecker
   void CheckIsLoopIvPartOfClause(
       llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
   void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
+
+  void CheckLoopItrVariableIsInt(const parser::OpenMPLoopConstruct &x);
+  void CheckDoWhile(const parser::OpenMPLoopConstruct &x);
+  void CheckCycleConstraints(const parser::OpenMPLoopConstruct &x);
+  std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x);
+  void CheckIfDoOrderedClause(const parser::OmpBlockDirective &blkDirectiv);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
@@ -1070,6 +1070,15 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
   }
   ClearDataSharingAttributeObjects();
   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
+
+  if (beginDir.v == llvm::omp::Directive::OMPD_do) {
+    if (const auto &doConstruct{
+            std::get<std::optional<parser::DoConstruct>>(x.t)}) {
+      if (doConstruct.value().IsDoWhile()) {
+        return true;
+      }
+    }
+  }
   PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
   return true;
 }

diff --git a/flang/test/Semantics/omp-do06-positivecases.f90 b/flang/test/Semantics/omp-do06-positivecases.f90
@@ -0,0 +1,23 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.1 Loop Construct
+! The ordered clause must be present on the loop construct if any ordered
+! region ever binds to a loop region arising from the loop construct.
+
+! A positive case
+!DEF: /omp_do MainProgram
+program omp_do
+  !DEF: /omp_do/i ObjectEntity INTEGER(4)
+  !DEF: /omp_do/j ObjectEntity INTEGER(4)
+  !DEF: /omp_do/k ObjectEntity INTEGER(4)
+  integer i, j, k
+  !$omp do  ordered
+    !DEF: /omp_do/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+    do i=1,10
+      !$omp ordered
+      !DEF: /my_func EXTERNAL (Subroutine) ProcEntity
+      call my_func
+      !$omp end ordered
+    end do
+  !$omp end do
+end program omp_do
diff --git a/flang/test/Semantics/omp-do06.f90 b/flang/test/Semantics/omp-do06.f90
@@ -1,6 +1,4 @@
 ! RUN: %S/test_errors.sh %s %t %flang -fopenmp
-! XFAIL:*
-
 ! OpenMP Version 4.5
 ! 2.7.1 Loop Construct
 ! The ordered clause must be present on the loop construct if any ordered
@@ -11,11 +9,25 @@ program omp_do
 
   !$omp do
   do i = 1, 10
-    !ERROR: ‘ordered’ region inside a loop region without an ordered clause.
+    !ERROR: The ORDERED clause must be present on the loop construct if any ORDERED region ever binds to a loop region arising from the loop construct.
     !$omp ordered
     call my_func()
     !$omp end ordered
   end do
   !$omp end do
 
+  !$omp do ordered private(i)
+  do i = 1, 10
+    !$omp parallel do
+    do j = 1, 10
+      print *,i
+      !ERROR: The ORDERED clause must be present on the loop construct if any ORDERED region ever binds to a loop region arising from the loop construct.
+      !$omp ordered
+      print *,i
+      !$omp end ordered
+    end do
+    !$omp end parallel do
+  end do
+  !$omp end do
+
 end program omp_do