[flang-commits] [flang] 4a51691 - [Flang][OpenACC] Fix for branching out issue in OpenACC parallel construct.
Sameeran joshi via flang-commits
flang-commits at lists.llvm.org
Mon Oct 19 09:17:06 PDT 2020
Author: sameeran joshi
Date: 2020-10-19T21:46:47+05:30
New Revision: 4a51691a85a1c048b9028d409b744a6235c55933
URL: https://github.com/llvm/llvm-project/commit/4a51691a85a1c048b9028d409b744a6235c55933
DIFF: https://github.com/llvm/llvm-project/commit/4a51691a85a1c048b9028d409b744a6235c55933.diff
LOG: [Flang][OpenACC] Fix for branching out issue in OpenACC parallel construct.
From OpenACC 3.0 Standards document
840 • A program may not branch into or out of an OpenACC parallel construct.
Exits are allowed provided it does not cause an exit outside the parallel region.
Test case exits out of the inner do loop, but it is still inside the parallel region.
Patch tries to extract labels from block attached to a construct,
If the exit is to a label not in the collected list then flags an error.
Reviewed By: tskeith
Differential Revision: https://reviews.llvm.org/D87906
Added:
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/check-acc-structure.cpp
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/acc-branch.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 6e1e06b3ec76..02faad4ecb2f 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -542,6 +542,8 @@ class LabelEnforce {
parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
parser::CharBlock constructLocation);
};
-
+// Return the (possibly null) name of the ConstructNode
+const std::optional<parser::Name> &MaybeGetNodeName(
+ const ConstructNode &construct);
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TOOLS_H_
diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index 4dcf5ed27f70..cf424f223fee 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -5,7 +5,6 @@
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
-
#include "check-acc-structure.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/tools.h"
@@ -59,16 +58,22 @@ class NoBranchingEnforce {
return true;
}
- void Post(const parser::ReturnStmt &) { emitBranchOutError("RETURN"); }
- void Post(const parser::ExitStmt &) { emitBranchOutError("EXIT"); }
- void Post(const parser::StopStmt &) { emitBranchOutError("STOP"); }
+ void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); }
+ void Post(const parser::ExitStmt &exitStmt) {
+ if (const auto &exitName{exitStmt.v}) {
+ CheckConstructNameBranching("EXIT", exitName.value());
+ }
+ }
+ void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); }
private:
- parser::MessageFixedText GetEnclosingMsg() {
- return "Enclosing block construct"_en_US;
+ parser::MessageFormattedText GetEnclosingMsg() const {
+ return {"Enclosing %s construct"_en_US,
+ parser::ToUpperCaseLetters(
+ llvm::acc::getOpenACCDirectiveName(currentDirective_).str())};
}
- void emitBranchOutError(const char *stmt) {
+ void EmitBranchOutError(const char *stmt) const {
context_
.Say(currentStatementSourcePosition_,
"%s statement is not allowed in a %s construct"_err_en_US, stmt,
@@ -77,6 +82,39 @@ class NoBranchingEnforce {
.Attach(sourcePosition_, GetEnclosingMsg());
}
+ void EmitBranchOutErrorWithName(
+ const char *stmt, const parser::Name &toName) const {
+ const std::string branchingToName{toName.ToString()};
+ const auto upperCaseConstructName{parser::ToUpperCaseLetters(
+ llvm::acc::getOpenACCDirectiveName(currentDirective_).str())};
+ context_
+ .Say(currentStatementSourcePosition_,
+ "%s to construct '%s' outside of %s construct is not allowed"_err_en_US,
+ stmt, branchingToName, upperCaseConstructName)
+ .Attach(sourcePosition_, GetEnclosingMsg());
+ }
+
+ // Current semantic checker is not following OpenACC constructs as they are
+ // not Fortran constructs. Hence the ConstructStack doesn't capture OpenACC
+ // constructs. Apply an inverse way to figure out if a construct-name is
+ // branching out of an OpenACC construct. The control flow goes out of an
+ // OpenACC construct, if a construct-name from statement is found in
+ // ConstructStack.
+ void CheckConstructNameBranching(
+ const char *stmt, const parser::Name &stmtName) {
+ const ConstructStack &stack{context_.constructStack()};
+ for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {
+ const ConstructNode &construct{*iter};
+ const auto &constructName{MaybeGetNodeName(construct)};
+ if (constructName) {
+ if (stmtName.source == constructName->source) {
+ EmitBranchOutErrorWithName(stmt, stmtName);
+ return;
+ }
+ }
+ }
+ }
+
SemanticsContext &context_;
parser::CharBlock currentStatementSourcePosition_;
parser::CharBlock sourcePosition_;
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index 68be15e620ba..ae1fcb610385 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -72,23 +72,10 @@ static const parser::Name &GetDoVariable(
return bounds.name.thing;
}
-// Return the (possibly null) name of the construct
-template <typename A>
-static const parser::Name *MaybeGetConstructName(const A &a) {
- return common::GetPtrFromOptional(std::get<0>(std::get<0>(a.t).statement.t));
-}
-
static parser::MessageFixedText GetEnclosingDoMsg() {
return "Enclosing DO CONCURRENT statement"_en_US;
}
-static const parser::Name *MaybeGetConstructName(
- const parser::BlockConstruct &blockConstruct) {
- return common::GetPtrFromOptional(
- std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
- .statement.v);
-}
-
static void SayWithDo(SemanticsContext &context, parser::CharBlock stmtLocation,
parser::MessageFixedText &&message, parser::CharBlock doLocation) {
context.Say(stmtLocation, message).Attach(doLocation, GetEnclosingDoMsg());
@@ -329,12 +316,6 @@ class DoConcurrentBodyEnforce {
}
private:
- // Return the (possibly null) name of the statement
- template <typename A>
- static const parser::Name *MaybeGetStmtName(const A &a) {
- return common::GetPtrFromOptional(std::get<0>(a.t));
- }
-
bool fromScope(const Symbol &symbol, const std::string &moduleName) {
if (symbol.GetUltimate().owner().IsModule() &&
symbol.GetUltimate().owner().GetName().value().ToString() ==
@@ -845,12 +826,6 @@ void DoForallChecker::Leave(const parser::ForallAssignmentStmt &stmt) {
doContext.Check(stmt);
}
-// Return the (possibly null) name of the ConstructNode
-static const parser::Name *MaybeGetNodeName(const ConstructNode &construct) {
- return std::visit(
- [&](const auto &x) { return MaybeGetConstructName(*x); }, construct);
-}
-
template <typename A>
static parser::CharBlock GetConstructPosition(const A &a) {
return std::get<0>(a.t).source;
@@ -910,7 +885,7 @@ void DoForallChecker::CheckForBadLeave(
}
static bool StmtMatchesConstruct(const parser::Name *stmtName,
- StmtType stmtType, const parser::Name *constructName,
+ StmtType stmtType, const std::optional<parser::Name> &constructName,
const ConstructNode &construct) {
bool inDoConstruct{MaybeGetDoConstruct(construct) != nullptr};
if (!stmtName) {
@@ -939,7 +914,8 @@ void DoForallChecker::CheckNesting(
const ConstructStack &stack{context_.constructStack()};
for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {
const ConstructNode &construct{*iter};
- const parser::Name *constructName{MaybeGetNodeName(construct)};
+ const std::optional<parser::Name> &constructName{
+ MaybeGetNodeName(construct)};
if (StmtMatchesConstruct(stmtName, stmtType, constructName, construct)) {
CheckDoConcurrentExit(stmtType, construct);
return; // We got a match, so we're finished checking
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 8bcbdc70ec11..0ab2b376b3e2 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1359,4 +1359,19 @@ bool InCommonBlock(const Symbol &symbol) {
return details && details->commonBlock();
}
+const std::optional<parser::Name> &MaybeGetNodeName(
+ const ConstructNode &construct) {
+ return std::visit(
+ common::visitors{
+ [&](const parser::BlockConstruct *blockConstruct)
+ -> const std::optional<parser::Name> & {
+ return std::get<0>(blockConstruct->t).statement.v;
+ },
+ [&](const auto *a) -> const std::optional<parser::Name> & {
+ return std::get<0>(std::get<0>(a->t).statement.t);
+ },
+ },
+ construct);
+}
+
} // namespace Fortran::semantics
diff --git a/flang/test/Semantics/acc-branch.f90 b/flang/test/Semantics/acc-branch.f90
index b1c2a6b860e4..e0968732074f 100644
--- a/flang/test/Semantics/acc-branch.f90
+++ b/flang/test/Semantics/acc-branch.f90
@@ -2,12 +2,11 @@
! Check OpenACC restruction in branch in and out of some construct
!
-
program openacc_clause_validity
implicit none
- integer :: i
+ integer :: i, j, k
integer :: N = 256
real(8) :: a(256)
@@ -25,12 +24,70 @@ program openacc_clause_validity
do i = 1, N
a(i) = 3.14
if(i == N-1) THEN
- !ERROR: EXIT statement is not allowed in a PARALLEL construct
exit
end if
end do
!$acc end parallel
+ ! Exit branches out of parallel construct, not attached to an OpenACC parallel construct.
+ name1: do k=1, N
+ !$acc parallel
+ !$acc loop
+ outer: do i=1, N
+ inner: do j=1, N
+ ifname: if (j == 2) then
+ ! These are allowed.
+ exit
+ exit inner
+ exit outer
+ !ERROR: EXIT to construct 'name1' outside of PARALLEL construct is not allowed
+ exit name1
+ ! Exit to construct other than loops.
+ exit ifname
+ end if ifname
+ end do inner
+ end do outer
+ !$acc end parallel
+ end do name1
+
+ ! Exit branches out of parallel construct, attached to an OpenACC parallel construct.
+ thisblk: BLOCK
+ fortname: if (.true.) then
+ name1: do k = 1, N
+ !$acc parallel
+ !ERROR: EXIT to construct 'fortname' outside of PARALLEL construct is not allowed
+ exit fortname
+ !$acc loop
+ do i = 1, N
+ a(i) = 3.14
+ if(i == N-1) THEN
+ !ERROR: EXIT to construct 'name1' outside of PARALLEL construct is not allowed
+ exit name1
+ end if
+ end do
+
+ loop2: do i = 1, N
+ a(i) = 3.33
+ !ERROR: EXIT to construct 'thisblk' outside of PARALLEL construct is not allowed
+ exit thisblk
+ end do loop2
+ !$acc end parallel
+ end do name1
+ end if fortname
+ end BLOCK thisblk
+
+ !Exit branches inside OpenACC construct.
+ !$acc parallel
+ !$acc loop
+ do i = 1, N
+ a(i) = 3.14
+ ifname: if (i == 2) then
+ ! This is allowed.
+ exit ifname
+ end if ifname
+ end do
+ !$acc end parallel
+
!$acc parallel
!$acc loop
do i = 1, N
@@ -54,7 +111,6 @@ program openacc_clause_validity
do i = 1, N
a(i) = 3.14
if(i == N-1) THEN
- !ERROR: EXIT statement is not allowed in a KERNELS construct
exit
end if
end do
@@ -82,12 +138,27 @@ program openacc_clause_validity
do i = 1, N
a(i) = 3.14
if(i == N-1) THEN
- !ERROR: EXIT statement is not allowed in a SERIAL construct
exit
end if
end do
!$acc end serial
+ name2: do k=1, N
+ !$acc serial
+ do i = 1, N
+ ifname: if (.true.) then
+ print *, "LGTM"
+ a(i) = 3.14
+ if(i == N-1) THEN
+ !ERROR: EXIT to construct 'name2' outside of SERIAL construct is not allowed
+ exit name2
+ exit ifname
+ end if
+ end if ifname
+ end do
+ !$acc end serial
+ end do name2
+
!$acc serial
do i = 1, N
a(i) = 3.14
More information about the flang-commits
mailing list