[flang][openacc] Accept !$acc end loop

[clementval]

Summary

Some compilers accept !$acc end loop associated with an !$acc loop
directive. This patch updates the acc loop parser to accept it as well.
The parser is also updated to be stricter on the following statement
to match the OpenACC combined construct parser.
The rewrite canonicalization is not a rewrite anymore and the naming
will be updated in a follow up patch for the Loop and Combined constructs.

[clementval]

Add missing test file

[razvanlupusoru]

Looks great to me!

flang/docs/OpenACC.md

 .. contents::
    :local:
 ```
 
 ## Intentional deviation from the specification
 * The end directive for combined construct can omit the `loop` keyword.
 * An `!$acc routine` with no parallelism clause is treated as if the `seq`
   clause was present.
+* `!$acc end loop` does not trigger a parsing error and is just ignored.

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

#include "llvm/Frontend/OpenACC/ACC.inc"
   NODE(parser, AccSizeExprList)
   NODE(parser, AccSelfClause)
   NODE(parser, AccStandaloneDirective)
   NODE(parser, AccDeviceTypeExpr)
   NODE(parser, AccDeviceTypeExprList)
   NODE(parser, AccTileExpr)
   NODE(parser, AccTileExprList)
   NODE(parser, AccLoopDirective)
+  NODE(parser, AccEndLoop)
   NODE(parser, AccWaitArgument)
   static std::string GetNodeName(const llvm::acc::Directive &x) {
     return llvm::Twine(
         "llvm::acc::Directive = ", llvm::acc::getOpenACCDirectiveName(x))
         .str();
   }
   NODE(parser, AcImpliedDo)
   NODE(parser, AcImpliedDoControl)

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

 struct OpenACCDeclarativeConstruct {
   UNION_CLASS_BOILERPLATE(OpenACCDeclarativeConstruct);
   CharBlock source;
   std::variant<OpenACCStandaloneDeclarativeConstruct, OpenACCRoutineConstruct>
       u;
 };
 
 // OpenACC directives enclosing do loop
+EMPTY_CLASS(AccEndLoop);
 struct OpenACCLoopConstruct {
   TUPLE_CLASS_BOILERPLATE(OpenACCLoopConstruct);
-  OpenACCLoopConstruct(AccBeginLoopDirective &&a)
-      : t({std::move(a), std::nullopt}) {}
-  std::tuple<AccBeginLoopDirective, std::optional<DoConstruct>> t;
+  std::tuple<AccBeginLoopDirective, DoConstruct, std::optional<AccEndLoop>> t;
 };
 
 struct OpenACCStandaloneConstruct {
   TUPLE_CLASS_BOILERPLATE(OpenACCStandaloneConstruct);
   CharBlock source;
   std::tuple<AccStandaloneDirective, AccClauseList> t;
 };
 

flang/lib/Parser/openacc-parsers.cpp

 
 // Loop directives
 TYPE_PARSER(sourced(construct<AccLoopDirective>(
     first("LOOP" >> pure(llvm::acc::Directive::ACCD_loop)))))
 
 TYPE_PARSER(construct<AccBeginLoopDirective>(
     sourced(Parser<AccLoopDirective>{}), Parser<AccClauseList>{}))
 
-TYPE_PARSER(
-    construct<OpenACCLoopConstruct>(sourced(Parser<AccBeginLoopDirective>{})))
+TYPE_PARSER(construct<AccEndLoop>(startAccLine >> "END LOOP"_tok))
+
+TYPE_PARSER(construct<OpenACCLoopConstruct>(
+    sourced(Parser<AccBeginLoopDirective>{} / endAccLine),
+    withMessage("A DO loop must follow the loop construct"_err_en_US,
+        Parser<DoConstruct>{}),
+    maybe(Parser<AccEndLoop>{} / endAccLine)))
 
 // 2.15.1 Routine directive
 TYPE_PARSER(sourced(construct<OpenACCRoutineConstruct>(verbatim("ROUTINE"_tok),
     maybe(parenthesized(name)), Parser<AccClauseList>{})))
 
 // 2.10 Cache directive
 TYPE_PARSER(sourced(
     construct<OpenACCCacheConstruct>(sourced(construct<Verbatim>("CACHE"_tok)),

flang/lib/Parser/unparse.cpp

void Unparse(const OpenACCBlockConstruct &x) {
     EndOpenACC();
   }
   void Unparse(const OpenACCLoopConstruct &x) {
     BeginOpenACC();
     Word("!$ACC ");
     Walk(std::get<AccBeginLoopDirective>(x.t));
     Put("\n");
     EndOpenACC();
-    Walk(std::get<std::optional<DoConstruct>>(x.t));
+    Walk(std::get<DoConstruct>(x.t));
   }
   void Unparse(const AccBeginLoopDirective &x) {
     Walk(std::get<AccLoopDirective>(x.t));
     Walk(std::get<AccClauseList>(x.t));
   }
   void Unparse(const OpenACCStandaloneConstruct &x) {
     BeginOpenACC();
     Word("!$ACC ");

flang/lib/Semantics/canonicalize-acc.cpp

void Post(parser::Block &block) {
     } // Block list
   }
 
 private:
   // Check constraint in 2.9.7
   // If there are n tile sizes in the list, the loop construct must be
   // immediately followed by n tightly-nested loops.
   template <typename C, typename D>
-  void CheckTileClauseRestriction(const C &x) {
+  void CheckTileClauseRestriction(
+      const C &x, const parser::DoConstruct &outer) {
     const auto &beginLoopDirective = std::get<D>(x.t);
     const auto &accClauseList =
         std::get<parser::AccClauseList>(beginLoopDirective.t);
     for (const auto &clause : accClauseList.v) {
       if (const auto *tileClause =
               std::get_if<parser::AccClause::Tile>(&clause.u)) {
         const parser::AccTileExprList &tileExprList = tileClause->v;
         const std::list<parser::AccTileExpr> &listTileExpr = tileExprList.v;
         std::size_t tileArgNb = listTileExpr.size();
 
-        const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
-        if (outer->IsDoConcurrent()) {
+        if (outer.IsDoConcurrent()) {
           return; // Tile is not allowed on DO CONCURRENT
         }
-        for (const parser::DoConstruct *loop{&*outer}; loop && tileArgNb > 0;
+        for (const parser::DoConstruct *loop{&outer}; loop && tileArgNb > 0;
              --tileArgNb) {
           const auto &block{std::get<parser::Block>(loop->t)};
           const auto it{block.begin()};
           loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
                                    : nullptr;
         }
 
         if (tileArgNb > 0) {
           messages_.Say(beginLoopDirective.source,
               "The loop construct with the TILE clause must be followed by %d "
               "tightly-nested loops"_err_en_US,
               listTileExpr.size());
         }
       }
     }
   }
 
   // Check constraint on line 1835 in Section 2.9
   // A tile and collapse clause may not appear on loop that is associated with
   // do concurrent.
   template <typename C, typename D>
-  void CheckDoConcurrentClauseRestriction(const C &x) {
-    const auto &doCons{std::get<std::optional<parser::DoConstruct>>(x.t)};
-    if (!doCons->IsDoConcurrent()) {
+  void CheckDoConcurrentClauseRestriction(
+      const C &x, const parser::DoConstruct &doCons) {
+    if (!doCons.IsDoConcurrent()) {
       return;
     }
     const auto &beginLoopDirective = std::get<D>(x.t);
     const auto &accClauseList =
         std::get<parser::AccClauseList>(beginLoopDirective.t);
     for (const auto &clause : accClauseList.v) {
       if (std::holds_alternative<parser::AccClause::Collapse>(clause.u) ||
           std::holds_alternative<parser::AccClause::Tile>(clause.u)) {
         messages_.Say(beginLoopDirective.source,
             "TILE and COLLAPSE clause may not appear on loop construct "
             "associated with DO CONCURRENT"_err_en_US);
       }
     }
   }
 
   void RewriteOpenACCLoopConstruct(parser::OpenACCLoopConstruct &x,
       parser::Block &block, parser::Block::iterator it) {
-    // Check the sequence of DoConstruct in the same iteration
-    //
-    // Original:
-    //   ExecutableConstruct -> OpenACCConstruct -> OpenACCLoopConstruct
-    //     ACCBeginLoopDirective
-    //   ExecutableConstruct -> DoConstruct
-    //
-    // After rewriting:
-    //   ExecutableConstruct -> OpenACCConstruct -> OpenACCLoopConstruct
-    //     AccBeginLoopDirective
-    //     DoConstruct
-    parser::Block::iterator nextIt;
     auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
     auto &dir{std::get<parser::AccLoopDirective>(beginDir.t)};
+    const auto &doCons{std::get<parser::DoConstruct>(x.t)};
 
-    nextIt = it;
-    if (++nextIt != block.end()) {
-      if (auto *doCons{parser::Unwrap<parser::DoConstruct>(*nextIt)}) {
-        if (!doCons->GetLoopControl()) {
-          messages_.Say(dir.source,
-              "DO loop after the %s directive must have loop control"_err_en_US,
-              parser::ToUpperCaseLetters(dir.source.ToString()));
-          return;
-        }
+    if (!doCons.GetLoopControl()) {
 
-        // move DoConstruct
-        std::get<std::optional<parser::DoConstruct>>(x.t) = std::move(*doCons);
-        nextIt = block.erase(nextIt);
-
-        CheckDoConcurrentClauseRestriction<parser::OpenACCLoopConstruct,
-            parser::AccBeginLoopDirective>(x);
-        CheckTileClauseRestriction<parser::OpenACCLoopConstruct,
-            parser::AccBeginLoopDirective>(x);
-
-        return; // found do-loop
-      }
-    }
-    messages_.Say(dir.source,
-        "A DO loop must follow the %s directive"_err_en_US,
-        parser::ToUpperCaseLetters(dir.source.ToString()));
+        parser::AccBeginLoopDirective>(x, doCons);
+        parser::AccBeginLoopDirective>(x, doCons);
   }
 
   void RewriteOpenACCCombinedConstruct(parser::OpenACCCombinedConstruct &x,
       parser::Block &block, parser::Block::iterator it) {
-    // Check the sequence of DoConstruct in the same iteration
-    //
-    // Original:
-    //   ExecutableConstruct -> OpenACCConstruct -> OpenACCCombinedConstruct
-    //     ACCBeginCombinedDirective
-    //   ExecutableConstruct -> DoConstruct
-    //   ExecutableConstruct -> AccEndCombinedDirective (if available)
-    //
-    // After rewriting:
-    //   ExecutableConstruct -> OpenACCConstruct -> OpenACCCombinedConstruct
-    //     ACCBeginCombinedDirective
-    //     DoConstruct
-    //     AccEndCombinedDirective (if available)
+    // Check the sequence of DoConstruct in the same iteration.
     parser::Block::iterator nextIt;
     auto &beginDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
     auto &dir{std::get<parser::AccCombinedDirective>(beginDir.t)};
-    auto &doConstruct{std::get<std::optional<parser::DoConstruct>>(x.t)};
+    const auto &doConstruct{std::get<std::optional<parser::DoConstruct>>(x.t)};
 
     if (doConstruct) {
       CheckDoConcurrentClauseRestriction<parser::OpenACCCombinedConstruct,
-          parser::AccBeginCombinedDirective>(x);
+          parser::AccBeginCombinedDirective>(x, *doConstruct);
       CheckTileClauseRestriction<parser::OpenACCCombinedConstruct,
-          parser::AccBeginCombinedDirective>(x);
+          parser::AccBeginCombinedDirective>(x, *doConstruct);
       if (!doConstruct->GetLoopControl()) {
         messages_.Say(dir.source,
             "DO loop after the %s directive must have loop control"_err_en_US,
             parser::ToUpperCaseLetters(dir.source.ToString()));
         return;
       }
       return;
     }

flang/lib/Semantics/resolve-directives.cpp

for (const auto &entry : block) {
         continue;
       } else {
         break;
       }
     }
     return nullptr;
   };
 
-  const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
-  for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
+  const auto &outer{std::get<parser::DoConstruct>(x.t)};
+  for (const parser::DoConstruct *loop{&outer}; loop && level > 0; --level) {
     // go through all the nested do-loops and resolve index variables
     const parser::Name *iv{GetLoopIndex(*loop)};
     if (iv) {
       if (auto *symbol{ResolveAcc(*iv, ivDSA, currScope())}) {
         symbol->set(Symbol::Flag::AccPreDetermined);
         iv->symbol = symbol; // adjust the symbol within region
         AddToContextObjectWithDSA(*symbol, ivDSA);
       }

flang/test/Semantics/OpenACC/acc-canonicalization-validity.f90

program openacc_clause_validity
 
   implicit none
 
   integer :: i, j
   integer :: N = 256
   real(8) :: a(256)
   real(8) :: aa(256, 256)
 
-  !ERROR: A DO loop must follow the LOOP directive
-  !$acc loop
-  i = 1
+  i = 0
 
   !ERROR: DO loop after the LOOP directive must have loop control
   !$acc loop
   do
   end do
 
   !$acc parallel loop
   do i = 1, N

flang/test/Semantics/OpenACC/acc-loop-validity.f90

+! RUN: %python %S/../test_errors.py %s %flang -fopenacc
+
+program openacc_clause_validity
+
+  implicit none
+
+  integer :: i
+
+  i = 0
+
+  !$acc loop
+  !ERROR: A DO loop must follow the loop construct
+  i = 1
+
+end

flang/test/Semantics/OpenACC/acc-loop.f90

do i = 1, N
     end do
   end do
 
   !ERROR: The num argument is not allowed when dim is specified
   !$acc loop gang(1, dim: 2)
   do i = 1, N
   end do
 
+  !$acc loop
+  do i = 1, N
+  end do
+  !$acc end loop
+
 end program openacc_loop_validity