Merge pull request #1013 from flang-compiler/jpr-cherry-pick

Cherry pick all flang commits from LLVM since last cherry-picking

Author: jeanPerier

flang/docs/Extensions.md

@@ -58,6 +58,11 @@ write(buffer,*,delim="QUOTE") quotes
 print "('>',a10,'<')", buffer
 end
 ```
+* The name of the control variable in an implied DO loop in an array
+  constructor or DATA statement has a scope over the value-list only,
+  not the bounds of the implied DO loop.  It is not advisable to use
+  an object of the same name as the index variable in a bounds
+  expression, but it will work, instead of being needlessly undefined.
 
 ## Extensions, deletions, and legacy features supported by default
 

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

@@ -203,12 +203,6 @@ class DirectiveStructureChecker : public virtual BaseChecker {
     GetContext().actualClauses.push_back(type);
   }
 
-  void EnterSIMDNest() { simdNest_++; }
-
-  void ExitSIMDNest() { simdNest_--; }
-
-  int GetSIMDNest() { return simdNest_; }
-
   // Check if the given clause is present in the current context
   const PC *FindClause(C type) {
     auto it{GetContext().clauseInfo.find(type)};
@@ -320,7 +314,6 @@ class DirectiveStructureChecker : public virtual BaseChecker {
       directiveClausesMap_;
 
   std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
-  int simdNest_{0};
 };
 
 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>

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

@@ -285,9 +285,12 @@ void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
   // called individually for each construct.  Therefore a
   // dirContext_ size `1` means the current construct is nested
   if (dirContext_.size() >= 1) {
-    if (GetSIMDNest() > 0) {
+    if (GetDirectiveNest(SIMDNest) > 0) {
       CheckSIMDNest(x);
     }
+    if (GetDirectiveNest(TargetNest) > 0) {
+      CheckTargetNest(x);
+    }
   }
 }
 
@@ -306,7 +309,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
 
   PushContextAndClauseSets(beginDir.source, beginDir.v);
   if (llvm::omp::simdSet.test(GetContext().directive)) {
-    EnterSIMDNest();
+    EnterDirectiveNest(SIMDNest);
   }
 
   if (beginDir.v == llvm::omp::Directive::OMPD_do) {
@@ -473,6 +476,53 @@ void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
   }
 }
 
+void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
+  // 2.12.5 Target Construct Restriction
+  bool eligibleTarget{true};
+  llvm::omp::Directive ineligibleTargetDir;
+  std::visit(
+      common::visitors{
+          [&](const parser::OpenMPBlockConstruct &c) {
+            const auto &beginBlockDir{
+                std::get<parser::OmpBeginBlockDirective>(c.t)};
+            const auto &beginDir{
+                std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+            if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
+              eligibleTarget = false;
+              ineligibleTargetDir = beginDir.v;
+            }
+          },
+          [&](const parser::OpenMPStandaloneConstruct &c) {
+            std::visit(
+                common::visitors{
+                    [&](const parser::OpenMPSimpleStandaloneConstruct &c) {
+                      const auto &dir{
+                          std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
+                      if (dir.v == llvm::omp::Directive::OMPD_target_update ||
+                          dir.v ==
+                              llvm::omp::Directive::OMPD_target_enter_data ||
+                          dir.v ==
+                              llvm::omp::Directive::OMPD_target_exit_data) {
+                        eligibleTarget = false;
+                        ineligibleTargetDir = dir.v;
+                      }
+                    },
+                    [&](const auto &c) {},
+                },
+                c.u);
+          },
+          [&](const auto &c) {},
+      },
+      c.u);
+  if (!eligibleTarget) {
+    context_.Say(parser::FindSourceLocation(c),
+        "If %s directive is nested inside TARGET region, the behaviour "
+        "is unspecified"_en_US,
+        parser::ToUpperCaseLetters(
+            getDirectiveName(ineligibleTargetDir).str()));
+  }
+}
+
 std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
     const parser::OpenMPLoopConstruct &x) {
   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
@@ -585,7 +635,7 @@ void OmpStructureChecker::CheckDistLinear(
 
 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
   if (llvm::omp::simdSet.test(GetContext().directive)) {
-    ExitSIMDNest();
+    ExitDirectiveNest(SIMDNest);
   }
   dirContext_.pop_back();
 }
@@ -616,6 +666,9 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
 
   PushContextAndClauseSets(beginDir.source, beginDir.v);
+  if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
+    EnterDirectiveNest(TargetNest);
+  }
 
   if (CurrentDirectiveIsNested()) {
     CheckIfDoOrderedClause(beginDir);
@@ -625,11 +678,35 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
     if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
       CheckMasterNesting(x);
     }
+    // A teams region can only be strictly nested within the implicit parallel
+    // region or a target region.
+    if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
+        GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
+      context_.Say(parser::FindSourceLocation(x),
+          "%s region can only be strictly nested within the implicit parallel "
+          "region or TARGET region"_err_en_US,
+          ContextDirectiveAsFortran());
+    }
+    // If a teams construct is nested within a target construct, that target
+    // construct must contain no statements, declarations or directives outside
+    // of the teams construct.
+    if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
+        GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
+        !GetDirectiveNest(TargetBlockOnlyTeams)) {
+      context_.Say(GetContextParent().directiveSource,
+          "TARGET construct with nested TEAMS region contains statements or "
+          "directives outside of the TEAMS construct"_err_en_US);
+    }
   }
 
   CheckNoBranching(block, beginDir.v, beginDir.source);
 
   switch (beginDir.v) {
+  case llvm::omp::Directive::OMPD_target:
+    if (CheckTargetBlockOnlyTeams(block)) {
+      EnterDirectiveNest(TargetBlockOnlyTeams);
+    }
+    break;
   case llvm::omp::OMPD_workshare:
   case llvm::omp::OMPD_parallel_workshare:
     CheckWorkshareBlockStmts(block, beginDir.source);
@@ -683,6 +760,12 @@ void OmpStructureChecker::CheckIfDoOrderedClause(
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
+  if (GetDirectiveNest(TargetBlockOnlyTeams)) {
+    ExitDirectiveNest(TargetBlockOnlyTeams);
+  }
+  if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
+    ExitDirectiveNest(TargetNest);
+  }
   dirContext_.pop_back();
 }
 
@@ -846,7 +929,9 @@ void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
 
 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &type{std::get<parser::OmpCancelType>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
+  CheckCancellationNest(dir.source, type.v);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
@@ -867,15 +952,140 @@ void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
 void OmpStructureChecker::Enter(
     const parser::OpenMPCancellationPointConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
+  const auto &type{std::get<parser::OmpCancelType>(x.t)};
   PushContextAndClauseSets(
       dir.source, llvm::omp::Directive::OMPD_cancellation_point);
+  CheckCancellationNest(dir.source, type.v);
 }
 
 void OmpStructureChecker::Leave(
     const parser::OpenMPCancellationPointConstruct &) {
   dirContext_.pop_back();
 }
 
+void OmpStructureChecker::CheckCancellationNest(
+    const parser::CharBlock &source, const parser::OmpCancelType::Type &type) {
+  if (CurrentDirectiveIsNested()) {
+    // If construct-type-clause is taskgroup, the cancellation construct must be
+    // closely nested inside a task or a taskloop construct and the cancellation
+    // region must be closely nested inside a taskgroup region. If
+    // construct-type-clause is sections, the cancellation construct must be
+    // closely nested inside a sections or section construct. Otherwise, the
+    // cancellation construct must be closely nested inside an OpenMP construct
+    // that matches the type specified in construct-type-clause of the
+    // cancellation construct.
+
+    OmpDirectiveSet allowedTaskgroupSet{
+        llvm::omp::Directive::OMPD_task, llvm::omp::Directive::OMPD_taskloop};
+    OmpDirectiveSet allowedSectionsSet{llvm::omp::Directive::OMPD_sections,
+        llvm::omp::Directive::OMPD_parallel_sections};
+    OmpDirectiveSet allowedDoSet{llvm::omp::Directive::OMPD_do,
+        llvm::omp::Directive::OMPD_distribute_parallel_do,
+        llvm::omp::Directive::OMPD_parallel_do,
+        llvm::omp::Directive::OMPD_target_parallel_do,
+        llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do,
+        llvm::omp::Directive::OMPD_teams_distribute_parallel_do};
+    OmpDirectiveSet allowedParallelSet{llvm::omp::Directive::OMPD_parallel,
+        llvm::omp::Directive::OMPD_target_parallel};
+
+    bool eligibleCancellation{false};
+    switch (type) {
+    case parser::OmpCancelType::Type::Taskgroup:
+      if (allowedTaskgroupSet.test(GetContextParent().directive)) {
+        eligibleCancellation = true;
+        if (dirContext_.size() >= 3) {
+          // Check if the cancellation region is closely nested inside a
+          // taskgroup region when there are more than two levels of directives
+          // in the directive context stack.
+          if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
+              FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
+            for (int i = dirContext_.size() - 3; i >= 0; i--) {
+              if (dirContext_[i].directive ==
+                  llvm::omp::Directive::OMPD_taskgroup) {
+                break;
+              }
+              if (allowedParallelSet.test(dirContext_[i].directive)) {
+                eligibleCancellation = false;
+                break;
+              }
+            }
+          }
+        }
+      }
+      if (!eligibleCancellation) {
+        context_.Say(source,
+            "With %s clause, %s construct must be closely nested inside TASK "
+            "or TASKLOOP construct and %s region must be closely nested inside "
+            "TASKGROUP region"_err_en_US,
+            parser::ToUpperCaseLetters(
+                parser::OmpCancelType::EnumToString(type)),
+            ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
+      }
+      return;
+    case parser::OmpCancelType::Type::Sections:
+      if (allowedSectionsSet.test(GetContextParent().directive)) {
+        eligibleCancellation = true;
+      }
+      break;
+    case Fortran::parser::OmpCancelType::Type::Do:
+      if (allowedDoSet.test(GetContextParent().directive)) {
+        eligibleCancellation = true;
+      }
+      break;
+    case parser::OmpCancelType::Type::Parallel:
+      if (allowedParallelSet.test(GetContextParent().directive)) {
+        eligibleCancellation = true;
+      }
+      break;
+    }
+    if (!eligibleCancellation) {
+      context_.Say(source,
+          "With %s clause, %s construct cannot be closely nested inside %s "
+          "construct"_err_en_US,
+          parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)),
+          ContextDirectiveAsFortran(),
+          parser::ToUpperCaseLetters(
+              getDirectiveName(GetContextParent().directive).str()));
+    }
+  } else {
+    // The cancellation directive cannot be orphaned.
+    switch (type) {
+    case parser::OmpCancelType::Type::Taskgroup:
+      context_.Say(source,
+          "%s %s directive is not closely nested inside "
+          "TASK or TASKLOOP"_err_en_US,
+          ContextDirectiveAsFortran(),
+          parser::ToUpperCaseLetters(
+              parser::OmpCancelType::EnumToString(type)));
+      break;
+    case parser::OmpCancelType::Type::Sections:
+      context_.Say(source,
+          "%s %s directive is not closely nested inside "
+          "SECTION or SECTIONS"_err_en_US,
+          ContextDirectiveAsFortran(),
+          parser::ToUpperCaseLetters(
+              parser::OmpCancelType::EnumToString(type)));
+      break;
+    case Fortran::parser::OmpCancelType::Type::Do:
+      context_.Say(source,
+          "%s %s directive is not closely nested inside "
+          "the construct that matches the DO clause type"_err_en_US,
+          ContextDirectiveAsFortran(),
+          parser::ToUpperCaseLetters(
+              parser::OmpCancelType::EnumToString(type)));
+      break;
+    case parser::OmpCancelType::Type::Parallel:
+      context_.Say(source,
+          "%s %s directive is not closely nested inside "
+          "the construct that matches the PARALLEL clause type"_err_en_US,
+          ContextDirectiveAsFortran(),
+          parser::ToUpperCaseLetters(
+              parser::OmpCancelType::EnumToString(type)));
+      break;
+    }
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
   const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
   ResetPartialContext(dir.source);
@@ -1788,6 +1998,30 @@ void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
   }
 }
 
+bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
+    const parser::Block &block) {
+  bool nestedTeams{false};
+  auto it{block.begin()};
+
+  if (const auto *ompConstruct{parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
+    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)};
+      if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
+        nestedTeams = true;
+      }
+    }
+  }
+
+  if (nestedTeams && ++it == block.end()) {
+    return true;
+  }
+  return false;
+}
+
 void OmpStructureChecker::CheckWorkshareBlockStmts(
     const parser::Block &block, parser::CharBlock source) {
   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};

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

@@ -218,13 +218,17 @@ class OmpStructureChecker
   void SetLoopInfo(const parser::OpenMPLoopConstruct &x);
   void CheckIsLoopIvPartOfClause(
       llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
+  bool CheckTargetBlockOnlyTeams(const parser::Block &);
   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);
   void CheckDistLinear(const parser::OpenMPLoopConstruct &x);
   void CheckSIMDNest(const parser::OpenMPConstruct &x);
+  void CheckTargetNest(const parser::OpenMPConstruct &x);
+  void CheckCancellationNest(
+      const parser::CharBlock &source, const parser::OmpCancelType::Type &type);
   std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x);
   void CheckIfDoOrderedClause(const parser::OmpBlockDirective &blkDirectiv);
   bool CheckReductionOperators(const parser::OmpClause::Reduction &);
@@ -246,6 +250,17 @@ class OmpStructureChecker
   void CheckPredefinedAllocatorRestriction(
       const parser::CharBlock &source, const parser::Name &name);
   bool isPredefinedAllocator{false};
+  void EnterDirectiveNest(const int index) { directiveNest_[index]++; }
+  void ExitDirectiveNest(const int index) { directiveNest_[index]--; }
+  int GetDirectiveNest(const int index) { return directiveNest_[index]; }
+
+  enum directiveNestType {
+    SIMDNest,
+    TargetBlockOnlyTeams,
+    TargetNest,
+    LastType
+  };
+  int directiveNest_[LastType + 1] = {0};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_