[flang][openacc] Relax rule for end directive on combined construct

[clementval]

Summary

Make the keyword loop optional for the end driective on combined
construct. This done to extend compatibility with other compiler that
allow this.

[razvanlupusoru]

Thank you for relaxing this constraint.

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

60

Should this be removed?

[clementval]

Rebase + restore commented check

[razvanlupusoru]

Looks great to me! Thank you!

flang/docs/OpenACC.md

+<!--===- docs/Extensions.md 
+  
+   Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+   See https://llvm.org/LICENSE.txt for license information.
+   SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+  
+-->
+
+# OpenACC in Flang
+
+```eval_rst
+.. contents::
+   :local:
+```
+
+## Intentional deviation from the specification
+* The end directive for combined construct can omit the `loop` keyword.

flang/lib/Parser/executable-parsers.cpp

constexpr auto executableConstruct{first(
     construct<ExecutableConstruct>(indirect(Parser<CriticalConstruct>{})),
     construct<ExecutableConstruct>(indirect(Parser<IfConstruct>{})),
     construct<ExecutableConstruct>(indirect(Parser<SelectRankConstruct>{})),
     construct<ExecutableConstruct>(indirect(Parser<SelectTypeConstruct>{})),
     construct<ExecutableConstruct>(indirect(whereConstruct)),
     construct<ExecutableConstruct>(indirect(forallConstruct)),
     construct<ExecutableConstruct>(indirect(ompEndLoopDirective)),
     construct<ExecutableConstruct>(indirect(openmpConstruct)),
-    construct<ExecutableConstruct>(indirect(accEndCombinedDirective)),
-    construct<ExecutableConstruct>(indirect(openaccConstruct)),
+    construct<ExecutableConstruct>(indirect(Parser<OpenACCConstruct>{})),
     construct<ExecutableConstruct>(indirect(compilerDirective)),
     construct<ExecutableConstruct>(indirect(Parser<CUFKernelDoConstruct>{})))};
 
 // R510 execution-part-construct ->
 //        executable-construct | format-stmt | entry-stmt | data-stmt
 // Extension (PGI/Intel): also accept NAMELIST in execution part
 constexpr auto obsoleteExecutionPartConstruct{recovery(ignoredStatementPrefix >>
         fail<ExecutionPartConstruct>(

flang/lib/Parser/openacc-parsers.cpp

startAccLine >>
         first(construct<OpenACCConstruct>(Parser<OpenACCBlockConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCCombinedConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCLoopConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCStandaloneConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCCacheConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCWaitConstruct>{}),
             construct<OpenACCConstruct>(Parser<OpenACCAtomicConstruct>{})))
 
-TYPE_PARSER(startAccLine >> sourced(construct<AccEndCombinedDirective>(sourced(
-                                "END"_tok >> Parser<AccCombinedDirective>{}))))
+TYPE_PARSER(startAccLine >>
+    sourced(construct<AccEndCombinedDirective>(sourced("END"_tok >>
+        construct<AccCombinedDirective>("KERNELS"_tok >> maybe("LOOP"_tok) >>
+                pure(llvm::acc::Directive::ACCD_kernels_loop) ||
+            "PARALLEL"_tok >> maybe("LOOP"_tok) >>
+                pure(llvm::acc::Directive::ACCD_parallel_loop) ||
+            "SERIAL"_tok >> maybe("LOOP"_tok) >>
+                pure(llvm::acc::Directive::ACCD_serial_loop))))))
 
 TYPE_PARSER(construct<OpenACCCombinedConstruct>(
-    sourced(Parser<AccBeginCombinedDirective>{} / endAccLine)))
+    sourced(Parser<AccBeginCombinedDirective>{} / endAccLine),
+    withMessage("A DO loop must follow the combined construct"_err_en_US,
+        Parser<DoConstruct>{}),
+    maybe(Parser<AccEndCombinedDirective>{} / endAccLine)))
 
 } // namespace Fortran::parser

flang/lib/Parser/type-parsers.h

 constexpr Parser<SubroutineSubprogram> subroutineSubprogram; // R1534
 constexpr Parser<SubroutineStmt> subroutineStmt; // R1535
 constexpr Parser<DummyArg> dummyArg; // R1536
 constexpr Parser<EndSubroutineStmt> endSubroutineStmt; // R1537
 constexpr Parser<EntryStmt> entryStmt; // R1541
 constexpr Parser<ContainsStmt> containsStmt; // R1543
 constexpr Parser<CompilerDirective> compilerDirective;
 constexpr Parser<OpenACCConstruct> openaccConstruct;
-constexpr Parser<AccEndCombinedDirective> accEndCombinedDirective;
 constexpr Parser<OpenACCDeclarativeConstruct> openaccDeclarativeConstruct;
 constexpr Parser<OpenMPConstruct> openmpConstruct;
 constexpr Parser<OpenMPDeclarativeConstruct> openmpDeclarativeConstruct;
 constexpr Parser<OmpEndLoopDirective> ompEndLoopDirective;
 constexpr Parser<IntrinsicVectorTypeSpec> intrinsicVectorTypeSpec; // Extension
 constexpr Parser<VectorTypeSpec> vectorTypeSpec; // Extension
 constexpr Parser<UnsignedTypeSpec> unsignedTypeSpec; // Extension
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TYPE_PARSERS_H_

flang/lib/Semantics/canonicalize-acc.cpp

void RewriteOpenACCCombinedConstruct(parser::OpenACCCombinedConstruct &x,
     // After rewriting:
     //   ExecutableConstruct -> OpenACCConstruct -> OpenACCCombinedConstruct
     //     ACCBeginCombinedDirective
     //     DoConstruct
     //     AccEndCombinedDirective (if available)
     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)};
 
-    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;
-        }
-        // move DoConstruct
-        std::get<std::optional<parser::DoConstruct>>(x.t) = std::move(*doCons);
-        nextIt = block.erase(nextIt);
-        // try to match AccEndCombinedDirective
-        if (nextIt != block.end()) {
-          if (auto *endDir{
-                  parser::Unwrap<parser::AccEndCombinedDirective>(*nextIt)}) {
-            std::get<std::optional<parser::AccEndCombinedDirective>>(x.t) =
-                std::move(*endDir);
-            block.erase(nextIt);
-          }
-        }
-
-        CheckDoConcurrentClauseRestriction<parser::OpenACCCombinedConstruct,
-            parser::AccBeginCombinedDirective>(x);
-        CheckTileClauseRestriction<parser::OpenACCCombinedConstruct,
-            parser::AccBeginCombinedDirective>(x);
-
-        return; // found do-loop
+    if (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;
     }
     messages_.Say(dir.source,
         "A DO loop must follow the %s directive"_err_en_US,
         parser::ToUpperCaseLetters(dir.source.ToString()));
   }
 
   parser::Messages &messages_;
 };
 
 bool CanonicalizeAcc(parser::Messages &messages, parser::Program &program) {
   CanonicalizationOfAcc acc{messages};
   Walk(program, acc);
   return !messages.AnyFatalError();
 }
 } // namespace Fortran::semantics

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

program openacc_clause_validity
   !$acc loop
   i = 1
 
   !ERROR: DO loop after the LOOP directive must have loop control
   !$acc loop
   do
   end do
 
-  !ERROR: A DO loop must follow the PARALLEL LOOP directive
-  !$acc parallel loop
-  i = 1
-
-  !ERROR: A DO loop must follow the KERNELS LOOP directive
-  !$acc kernels loop
-  i = 1
-
-  !ERROR: A DO loop must follow the SERIAL LOOP directive
-  !$acc serial loop
-  i = 1
-
-  !ERROR: The END PARALLEL LOOP directive must follow the DO loop associated with the loop construct
-  !$acc end parallel loop
-
-  !ERROR: The END KERNELS LOOP directive must follow the DO loop associated with the loop construct
-  !$acc end kernels loop
-
-  !ERROR: The END SERIAL LOOP directive must follow the DO loop associated with the loop construct
-  !$acc end serial loop
-
   !$acc parallel loop
   do i = 1, N
     a(i) = 3.14
   end do
 
   !$acc kernels loop
   do i = 1, N
     a(i) = 3.14
program openacc_clause_validity
   !$acc end kernels loop
 
   !$acc serial loop
   do i = 1, N
     a(i) = 3.14
   end do
   !$acc end serial loop
 
   !ERROR: DO loop after the PARALLEL LOOP directive must have loop control
   !$acc parallel loop
   do
   end do
 
   !ERROR: DO loop after the KERNELS LOOP directive must have loop control
   !$acc kernels loop
   do
   end do

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

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

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

program openacc_kernels_loop_validity
 
   real(8), dimension(N) :: a, f, g, h
 
   !$acc kernels loop
   do i = 1, N
     a(i) = 3.14
   end do
 
+  !$acc kernels loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end kernels loop
+
+  !$acc kernels loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end kernels loop
+
   !$acc kernels loop num_gangs(8)
   do i = 1, N
     a(i) = 3.14
   end do
 
   !$acc kernels loop num_gangs(gang_size)
   do i = 1, N
     a(i) = 3.14

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

program openacc_parallel_loop_validity
   integer, dimension(N) :: c
   logical, dimension(N) :: d, e
   real :: reduction_r
   logical :: reduction_l
   logical :: ifCondition = .TRUE.
   real(8), dimension(N) :: a, f, g, h
   real(8), dimension(N, N) :: aa, bb, cc
 
+  !$acc parallel loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+
+  !$acc parallel loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end parallel
+
   !$acc parallel loop tile(2)
   do i = 1, N
     a(i) = 3.14
   end do
 
   !$acc parallel loop self
   do i = 1, N
     a(i) = 3.14

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

program openacc_serial_loop_validity
 
   !$acc serial loop
   do i = 1, N
     a(i) = 3.14
   end do
   !ERROR: Unmatched END PARALLEL LOOP directive
   !$acc end parallel loop
 
+  !$acc serial loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end serial loop
+
+  !$acc serial loop
+  do i = 1, N
+    a(i) = 3.14
+  end do
+  !$acc end serial
+
 end program openacc_serial_loop_validity