diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 5d92ecb058417..cb4bb59bf312c 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -4247,7 +4247,11 @@ struct OpenACCDeclarativeConstruct { EMPTY_CLASS(AccEndLoop); struct OpenACCLoopConstruct { TUPLE_CLASS_BOILERPLATE(OpenACCLoopConstruct); - std::tuple> t; + OpenACCLoopConstruct(AccBeginLoopDirective &&a) + : t({std::move(a), std::nullopt, std::nullopt}) {} + std::tuple, + std::optional> + t; }; struct OpenACCStandaloneConstruct { diff --git a/flang/lib/Parser/openacc-parsers.cpp b/flang/lib/Parser/openacc-parsers.cpp index afa12b88019bd..e1cbe6b86df91 100644 --- a/flang/lib/Parser/openacc-parsers.cpp +++ b/flang/lib/Parser/openacc-parsers.cpp @@ -154,9 +154,7 @@ TYPE_PARSER(construct(startAccLine >> "END LOOP"_tok)) TYPE_PARSER(construct( sourced(Parser{} / endAccLine), - withMessage("A DO loop must follow the loop construct"_err_en_US, - Parser{}), - maybe(Parser{} / endAccLine))) + maybe(Parser{}), maybe(Parser{} / endAccLine))) // 2.15.1 Routine directive TYPE_PARSER(sourced(construct(verbatim("ROUTINE"_tok), diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index 398545d315e5c..6cac3fb5859f8 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -1947,7 +1947,7 @@ class UnparseVisitor { Walk(std::get(x.t)); Put("\n"); EndOpenACC(); - Walk(std::get(x.t)); + Walk(std::get>(x.t)); } void Unparse(const AccBeginLoopDirective &x) { Walk(std::get(x.t)); diff --git a/flang/lib/Semantics/canonicalize-acc.cpp b/flang/lib/Semantics/canonicalize-acc.cpp index e79ab997637b0..3887e479cbce5 100644 --- a/flang/lib/Semantics/canonicalize-acc.cpp +++ b/flang/lib/Semantics/canonicalize-acc.cpp @@ -109,21 +109,37 @@ class CanonicalizationOfAcc { void RewriteOpenACCLoopConstruct(parser::OpenACCLoopConstruct &x, parser::Block &block, parser::Block::iterator it) { + parser::Block::iterator nextIt; auto &beginDir{std::get(x.t)}; auto &dir{std::get(beginDir.t)}; - const auto &doCons{std::get(x.t)}; + auto &nestedDo{std::get>(x.t)}; + + if (!nestedDo) { + nextIt = it; + if (++nextIt != block.end()) { + if (auto *doCons{parser::Unwrap(*nextIt)}) { + nestedDo = std::move(*doCons); + nextIt = block.erase(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())); + if (nestedDo) { + if (!nestedDo->GetLoopControl()) { + messages_.Say(dir.source, + "DO loop after the %s directive must have loop control"_err_en_US, + parser::ToUpperCaseLetters(dir.source.ToString())); + return; + } + CheckDoConcurrentClauseRestriction(x, *nestedDo); + CheckTileClauseRestriction(x, *nestedDo); return; } - - CheckDoConcurrentClauseRestriction(x, doCons); - CheckTileClauseRestriction(x, doCons); + messages_.Say(dir.source, + "A DO loop must follow the %s directive"_err_en_US, + parser::ToUpperCaseLetters(dir.source.ToString())); } void RewriteOpenACCCombinedConstruct(parser::OpenACCCombinedConstruct &x, diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 9a2689c2e6c81..63a3e1cd31549 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -1153,8 +1153,8 @@ void AccAttributeVisitor::PrivatizeAssociatedLoopIndex( return nullptr; }; - const auto &outer{std::get(x.t)}; - for (const parser::DoConstruct *loop{&outer}; loop && level > 0; --level) { + const auto &outer{std::get>(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) { diff --git a/flang/test/Lower/OpenACC/acc-loop.f90 b/flang/test/Lower/OpenACC/acc-loop.f90 index f902728b67100..ec5eff5da78e7 100644 --- a/flang/test/Lower/OpenACC/acc-loop.f90 +++ b/flang/test/Lower/OpenACC/acc-loop.f90 @@ -315,4 +315,10 @@ program acc_loop ! CHECK: %[[CACHE:.*]] = acc.cache varPtr(%{{.*}} : !fir.ref>) bounds(%{{.*}}) -> !fir.ref> {name = "b"} ! CHECK: acc.loop cache(%[[CACHE]] : !fir.ref>) + !$acc loop + do 100 i=0, n + 100 continue +! CHECK: acc.loop +! CHECK: fir.do_loop + end program diff --git a/flang/test/Semantics/OpenACC/acc-loop-validity.f90 b/flang/test/Semantics/OpenACC/acc-loop-validity.f90 index 906602640efac..205e67a4728fc 100644 --- a/flang/test/Semantics/OpenACC/acc-loop-validity.f90 +++ b/flang/test/Semantics/OpenACC/acc-loop-validity.f90 @@ -4,12 +4,16 @@ program openacc_clause_validity implicit none - integer :: i + integer :: i, n i = 0 + !ERROR: A DO loop must follow the LOOP directive !$acc loop - !ERROR: A DO loop must follow the loop construct i = 1 + !$acc loop + do 100 i=0, n + 100 continue + end