[flang][OpenMP] Allow utility constructs in specification part

flang/examples/FlangOmpReport/FlangOmpReportVisitor.cpp

@@ -106,10 +106,16 @@ std::string OpenMPCounterVisitor::getName(const OmpWrapperType &w) {
   return getName(*std::get<const OpenMPDeclarativeConstruct *>(w));
 }
 std::string OpenMPCounterVisitor::getName(const OpenMPDeclarativeConstruct &c) {
-  return std::visit(
-      [&](const auto &o) -> std::string {
-        const CharBlock &source{std::get<Verbatim>(o.t).source};
-        return normalize_construct_name(source.ToString());
+  return std::visit( //
+      Fortran::common::visitors{
+          [&](const OpenMPUtilityConstruct &o) -> std::string {
+            const CharBlock &source{o.source};
+            return normalize_construct_name(source.ToString());
+          },
+          [&](const auto &o) -> std::string {
+            const CharBlock &source{std::get<Verbatim>(o.t).source};
+            return normalize_construct_name(source.ToString());
+          },
       },
       c.u);
 }

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

@@ -4342,7 +4342,7 @@ struct OpenMPDeclarativeConstruct {
   std::variant<OpenMPDeclarativeAllocate, OpenMPDeclareMapperConstruct,
       OpenMPDeclareReductionConstruct, OpenMPDeclareSimdConstruct,
       OpenMPDeclareTargetConstruct, OpenMPThreadprivate,
-      OpenMPRequiresConstruct>
+      OpenMPRequiresConstruct, OpenMPUtilityConstruct>
       u;
 };
 

flang/lib/Lower/OpenMP/OpenMP.cpp

@@ -2586,6 +2586,10 @@ static void genOMPDispatch(lower::AbstractConverter &converter,
 //===----------------------------------------------------------------------===//
 // OpenMPDeclarativeConstruct visitors
 //===----------------------------------------------------------------------===//
+static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+                   semantics::SemanticsContext &semaCtx,
+                   lower::pft::Evaluation &eval,
+                   const parser::OpenMPUtilityConstruct &);
 
 static void
 genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,

flang/lib/Parser/openmp-parsers.cpp

@@ -1090,7 +1090,9 @@ TYPE_PARSER(startOmpLine >>
             construct<OpenMPDeclarativeConstruct>(
                 Parser<OpenMPRequiresConstruct>{}) ||
             construct<OpenMPDeclarativeConstruct>(
-                Parser<OpenMPThreadprivate>{})) /
+                Parser<OpenMPThreadprivate>{}) ||
+            construct<OpenMPDeclarativeConstruct>(
+                Parser<OpenMPUtilityConstruct>{})) /
             endOmpLine))
 
 // Block Construct

flang/lib/Parser/unparse.cpp

@@ -2631,81 +2631,64 @@ class UnparseVisitor {
     }
   }
   void Unparse(const OpenMPDeclareReductionConstruct &x) {
+    BeginOpenMP();
+    Word("!$OMP DECLARE REDUCTION ");
     Put("(");
     Walk(std::get<OmpReductionIdentifier>(x.t)), Put(" : ");
     Walk(std::get<std::list<DeclarationTypeSpec>>(x.t), ","), Put(" : ");
     Walk(std::get<OmpReductionCombiner>(x.t));
     Put(")");
     Walk(std::get<std::optional<OmpReductionInitializerClause>>(x.t));
+    EndOpenMP();
   }
-  bool Pre(const OpenMPDeclarativeConstruct &x) {
+
+  void Unparse(const OpenMPDeclareMapperConstruct &z) {
     BeginOpenMP();
-    Word("!$OMP ");
-    return common::visit(
-        common::visitors{
-            [&](const OpenMPDeclarativeAllocate &z) {
-              Word("ALLOCATE (");
-              Walk(std::get<OmpObjectList>(z.t));
-              Put(")");
-              Walk(std::get<OmpClauseList>(z.t));
-              Put("\n");
-              EndOpenMP();
-              return false;
-            },
-            [&](const OpenMPDeclareMapperConstruct &z) {
-              Word("DECLARE MAPPER (");
-              const auto &spec{std::get<OmpDeclareMapperSpecifier>(z.t)};
-              if (auto mapname{std::get<std::optional<Name>>(spec.t)}) {
-                Walk(mapname);
-                Put(":");
-              }
-              Walk(std::get<TypeSpec>(spec.t));
-              Put("::");
-              Walk(std::get<Name>(spec.t));
-              Put(")");
+    Word("!$OMP DECLARE MAPPER (");
+    const auto &spec{std::get<OmpDeclareMapperSpecifier>(z.t)};
+    if (auto mapname{std::get<std::optional<Name>>(spec.t)}) {
+      Walk(mapname);
+      Put(":");
+    }
+    Walk(std::get<TypeSpec>(spec.t));
+    Put("::");
+    Walk(std::get<Name>(spec.t));
+    Put(")");
 
-              Walk(std::get<OmpClauseList>(z.t));
-              Put("\n");
-              return false;
-            },
-            [&](const OpenMPDeclareReductionConstruct &) {
-              Word("DECLARE REDUCTION ");
-              return true;
-            },
-            [&](const OpenMPDeclareSimdConstruct &y) {
-              Word("DECLARE SIMD ");
-              Walk("(", std::get<std::optional<Name>>(y.t), ")");
-              Walk(std::get<OmpClauseList>(y.t));
-              Put("\n");
-              EndOpenMP();
-              return false;
-            },
-            [&](const OpenMPDeclareTargetConstruct &) {
-              Word("DECLARE TARGET ");
-              return true;
-            },
-            [&](const OpenMPRequiresConstruct &y) {
-              Word("REQUIRES ");
-              Walk(std::get<OmpClauseList>(y.t));
-              Put("\n");
-              EndOpenMP();
-              return false;
-            },
-            [&](const OpenMPThreadprivate &) {
-              Word("THREADPRIVATE (");
-              return true;
-            },
-        },
-        x.u);
+    Walk(std::get<OmpClauseList>(z.t));
+    Put("\n");
+    EndOpenMP();
+  }
+  void Unparse(const OpenMPDeclareSimdConstruct &y) {
+    BeginOpenMP();
+    Word("!$OMP DECLARE SIMD ");
+    Walk("(", std::get<std::optional<Name>>(y.t), ")");
+    Walk(std::get<OmpClauseList>(y.t));
+    Put("\n");
+    EndOpenMP();
   }
-  void Post(const OpenMPDeclarativeConstruct &) {
+  void Unparse(const OpenMPDeclareTargetConstruct &x) {
+    BeginOpenMP();
+    Word("!$OMP DECLARE TARGET ");
+    Walk(std::get<parser::OmpDeclareTargetSpecifier>(x.t));
     Put("\n");
     EndOpenMP();
   }
-  void Post(const OpenMPThreadprivate &) {
+  void Unparse(const OpenMPRequiresConstruct &y) {
+    BeginOpenMP();
+    Word("!$OMP REQUIRES ");
+    Walk(std::get<OmpClauseList>(y.t));
+    Put("\n");
+    EndOpenMP();
+  }
+  void Unparse(const OpenMPThreadprivate &x) {
+    BeginOpenMP();
+    Word("!$OMP THREADPRIVATE (");
+    Walk(std::get<parser::OmpObjectList>(x.t));
     Put(")\n");
     EndOpenMP();
   }
+
   bool Pre(const OmpMessageClause &x) {
     Walk(x.v);
     return false;

flang/lib/Semantics/canonicalize-omp.cpp

@@ -50,6 +50,43 @@ class CanonicalizationOfOmp {
 
   void Post(parser::ExecutionPart &body) { RewriteOmpAllocations(body); }
 
+  // Pre-visit all constructs that have both a specification part and
+  // an execution part, and store the connection between the two.
+  bool Pre(parser::BlockConstruct &x) {
+    auto *spec = &std::get<parser::BlockSpecificationPart>(x.t).v;
+    auto *block = &std::get<parser::Block>(x.t);
+    blockForSpec_.insert(std::make_pair(spec, block));
+    return true;
+  }
+  bool Pre(parser::MainProgram &x) {
+    auto *spec = &std::get<parser::SpecificationPart>(x.t);
+    auto *block = &std::get<parser::ExecutionPart>(x.t).v;
+    blockForSpec_.insert(std::make_pair(spec, block));
+    return true;
+  }
+  bool Pre(parser::FunctionSubprogram &x) {
+    auto *spec = &std::get<parser::SpecificationPart>(x.t);
+    auto *block = &std::get<parser::ExecutionPart>(x.t).v;
+    blockForSpec_.insert(std::make_pair(spec, block));
+    return true;
+  }
+  bool Pre(parser::SubroutineSubprogram &x) {
+    auto *spec = &std::get<parser::SpecificationPart>(x.t);
+    auto *block = &std::get<parser::ExecutionPart>(x.t).v;
+    blockForSpec_.insert(std::make_pair(spec, block));
+    return true;
+  }
+  bool Pre(parser::SeparateModuleSubprogram &x) {
+    auto *spec = &std::get<parser::SpecificationPart>(x.t);
+    auto *block = &std::get<parser::ExecutionPart>(x.t).v;
+    blockForSpec_.insert(std::make_pair(spec, block));
+    return true;
+  }
+
+  void Post(parser::SpecificationPart &spec) {
+    CanonicalizeUtilityConstructs(spec);
+  }
+
 private:
   template <typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) {
     if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) {
@@ -155,6 +192,131 @@ class CanonicalizationOfOmp {
     }
   }
 
+  // Canonicalization of utility constructs.
+  //
+  // This addresses the issue of utility constructs that appear at the
+  // boundary between the specification and the execution parts, e.g.
+  //   subroutine foo
+  //     integer :: x     ! Specification
+  //     !$omp nothing
+  //     x = 1            ! Execution
+  //     ...
+  //   end
+  //
+  // Utility constructs (error and nothing) can appear in both the
+  // specification part and the execution part, except "error at(execution)",
+  // which cannot be present in the specification part (whereas any utility
+  // construct can be in the execution part).
+  // When a utility construct is at the boundary, it should preferably be
+  // parsed as an element of the execution part, but since the specification
+  // part is parsed first, the utility construct ends up belonging to the
+  // specification part.
+  //
+  // To allow the likes of the following code to compile, move all utility
+  // construct that are at the end of the specification part to the beginning
+  // of the execution part.
+  //
+  // subroutine foo
+  //   !$omp error at(execution)  ! Initially parsed as declarative construct.
+  //                              ! Move it to the execution part.
+  // end
+
+  void CanonicalizeUtilityConstructs(parser::SpecificationPart &spec) {
+    auto found = blockForSpec_.find(&spec);
+    if (found == blockForSpec_.end()) {
+      // There is no corresponding execution part, so there is nothing to do.
+      return;
+    }
+    parser::Block &block = *found->second;
+
+    // There are two places where an OpenMP declarative construct can
+    // show up in the tuple in specification part:
+    // (1) in std::list<OpenMPDeclarativeConstruct>, or
+    // (2) in std::list<DeclarationConstruct>.
+    // The case (1) is only possible is the list (2) is empty.
+
+    auto &omps =
+        std::get<std::list<parser::OpenMPDeclarativeConstruct>>(spec.t);
+    auto &decls = std::get<std::list<parser::DeclarationConstruct>>(spec.t);
+
+    if (!decls.empty()) {
+      MoveUtilityConstructsFromDecls(decls, block);
+    } else {
+      MoveUtilityConstructsFromOmps(omps, block);
+    }
+  }
+
+  void MoveUtilityConstructsFromDecls(
+      std::list<parser::DeclarationConstruct> &decls, parser::Block &block) {
+    // Find the trailing range of DeclarationConstructs that are OpenMP
+    // utility construct, that are to be moved to the execution part.
+    std::list<parser::DeclarationConstruct>::reverse_iterator rlast = [&]() {
+      for (auto rit = decls.rbegin(), rend = decls.rend(); rit != rend; ++rit) {
+        parser::DeclarationConstruct &dc = *rit;
+        if (!std::holds_alternative<parser::SpecificationConstruct>(dc.u)) {
+          return rit;
+        }
+        auto &sc = std::get<parser::SpecificationConstruct>(dc.u);
+        using OpenMPDeclarativeConstruct =
+            common::Indirection<parser::OpenMPDeclarativeConstruct>;
+        if (!std::holds_alternative<OpenMPDeclarativeConstruct>(sc.u)) {
+          return rit;
+        }
+        // Got OpenMPDeclarativeConstruct. If it's not a utility construct
+        // then stop.
+        auto &odc = std::get<OpenMPDeclarativeConstruct>(sc.u).value();
+        if (!std::holds_alternative<parser::OpenMPUtilityConstruct>(odc.u)) {
+          return rit;
+        }
+      }
+      return decls.rend();
+    }();
+
+    std::transform(decls.rbegin(), rlast, std::front_inserter(block),
+        [](parser::DeclarationConstruct &dc) {
+          auto &sc = std::get<parser::SpecificationConstruct>(dc.u);
+          using OpenMPDeclarativeConstruct =
+              common::Indirection<parser::OpenMPDeclarativeConstruct>;
+          auto &oc = std::get<OpenMPDeclarativeConstruct>(sc.u).value();
+          auto &ut = std::get<parser::OpenMPUtilityConstruct>(oc.u);
+
+          return parser::ExecutionPartConstruct(parser::ExecutableConstruct(
+              common::Indirection(parser::OpenMPConstruct(std::move(ut)))));
+        });
+
+    decls.erase(rlast.base(), decls.end());
+  }
+
+  void MoveUtilityConstructsFromOmps(
+      std::list<parser::OpenMPDeclarativeConstruct> &omps,
+      parser::Block &block) {
+    using OpenMPDeclarativeConstruct = parser::OpenMPDeclarativeConstruct;
+    // Find the trailing range of OpenMPDeclarativeConstruct that are OpenMP
+    // utility construct, that are to be moved to the execution part.
+    std::list<OpenMPDeclarativeConstruct>::reverse_iterator rlast = [&]() {
+      for (auto rit = omps.rbegin(), rend = omps.rend(); rit != rend; ++rit) {
+        OpenMPDeclarativeConstruct &dc = *rit;
+        if (!std::holds_alternative<parser::OpenMPUtilityConstruct>(dc.u)) {
+          return rit;
+        }
+      }
+      return omps.rend();
+    }();
+
+    std::transform(omps.rbegin(), rlast, std::front_inserter(block),
+        [](parser::OpenMPDeclarativeConstruct &dc) {
+          auto &ut = std::get<parser::OpenMPUtilityConstruct>(dc.u);
+          return parser::ExecutionPartConstruct(parser::ExecutableConstruct(
+              common::Indirection(parser::OpenMPConstruct(std::move(ut)))));
+        });
+
+    omps.erase(rlast.base(), omps.end());
+  }
+
+  // Mapping from the specification parts to the blocks that follow in the
+  // same construct. This is for converting utility constructs to executable
+  // constructs.
+  std::map<parser::SpecificationPart *, parser::Block *> blockForSpec_;
   parser::Messages &messages_;
 };
 

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

@@ -614,6 +614,14 @@ void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
   deferredNonVariables_.clear();
 }
 
+void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
+  EnterDirectiveNest(DeclarativeNest);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeConstruct &x) {
+  ExitDirectiveNest(DeclarativeNest);
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
   loopStack_.push_back(&x);
   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
@@ -1697,6 +1705,16 @@ void OmpStructureChecker::Leave(const parser::OmpErrorDirective &x) {
   dirContext_.pop_back();
 }
 
+void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
+  CheckAllowedClause(llvm::omp::Clause::OMPC_at);
+  if (GetDirectiveNest(DeclarativeNest) > 0) {
+    if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {
+      context_.Say(GetContext().clauseSource,
+          "The ERROR directive with AT(EXECUTION) cannot appear in the specification part"_err_en_US);
+    }
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
   isPredefinedAllocator = true;
   const auto &dir{std::get<parser::Verbatim>(x.t)};
@@ -2856,7 +2874,6 @@ CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
 CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
 CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
 CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
-CHECK_SIMPLE_CLAUSE(At, OMPC_at)
 CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
 CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
 CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)