diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h index bd78d3cfe91e7..46fbc5191b38a 100644 --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -17,6 +17,7 @@ #include "flang/Semantics/tools.h" #include "llvm/ADT/iterator_range.h" +#include #include namespace Fortran::semantics { @@ -53,6 +54,21 @@ template class NoBranchingEnforce { } void Post(const parser::DoConstruct &) { numDoConstruct_--; } void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); } + void Post(const parser::GotoStmt &gotoStmt) { + if constexpr (std::is_same_v) { + switch ((llvm::acc::Directive)currentDirective_) { + case llvm::acc::Directive::ACCD_parallel: + case llvm::acc::Directive::ACCD_serial: + case llvm::acc::Directive::ACCD_kernels: + if (labelsInBlock_.count(gotoStmt.v) == 0) + EmitBranchOutOfComputeConstructError("GOTO"); + break; + default: + break; + } + } + } + void CollectLabel(parser::Label label) { labelsInBlock_.insert(label); } void Post(const parser::ExitStmt &exitStmt) { if (const auto &exitName{exitStmt.v}) { CheckConstructNameBranching("EXIT", exitName.value()); @@ -115,6 +131,14 @@ template class NoBranchingEnforce { .Attach(sourcePosition_, GetEnclosingMsg()); } + void EmitBranchOutOfComputeConstructError(const char *stmt) const { + context_ + .Say(currentStatementSourcePosition_, + "%s to a label outside of a %s construct is not allowed"_err_en_US, + stmt, upperCaseDirName_) + .Attach(sourcePosition_, GetEnclosingMsg()); + } + inline void EmitUnlabelledBranchOutError(const char *stmt) { context_ .Say(currentStatementSourcePosition_, @@ -172,6 +196,7 @@ template class NoBranchingEnforce { D currentDirective_; int numDoConstruct_; // tracks number of DoConstruct found AFTER encountering // an OpenMP/OpenACC directive + std::set labelsInBlock_; }; // Generic structure checker for directives/clauses language such as OpenMP @@ -401,12 +426,28 @@ class DirectiveStructureChecker : public virtual BaseChecker { std::string ClauseSetToString(const common::EnumSet set); }; +// Collect all labels defined in a block. +struct LabelCollector { + std::set labels; + template bool Pre(const T &) { return true; } + template void Post(const T &) {} + template bool Pre(const parser::Statement &stmt) { + if (stmt.label) + labels.insert(*stmt.label); + return true; + } +}; + template void DirectiveStructureChecker::CheckNoBranching( const parser::Block &block, D directive, const parser::CharBlock &directiveSource) { + LabelCollector labelCollector; + parser::Walk(block, labelCollector); NoBranchingEnforce noBranchingEnforce{ context_, directiveSource, directive, ContextDirectiveAsFortran()}; + for (auto label : labelCollector.labels) + noBranchingEnforce.CollectLabel(label); parser::Walk(block, noBranchingEnforce); } diff --git a/flang/test/Semantics/OpenACC/acc-branch.f90 b/flang/test/Semantics/OpenACC/acc-branch.f90 index 0a1bdc3afd65a..a39fd4609d87a 100644 --- a/flang/test/Semantics/OpenACC/acc-branch.f90 +++ b/flang/test/Semantics/OpenACC/acc-branch.f90 @@ -196,4 +196,48 @@ subroutine openacc_clause_validity !$acc end data + ! GOTO branching out of compute constructs is not allowed (spec 2.5.4). + !$acc parallel + do i = 1, N + a(i) = 3.14d0 + !ERROR: GOTO to a label outside of a PARALLEL construct is not allowed + if (i == N-1) goto 999 + end do + !$acc end parallel +999 continue + + !$acc kernels + do i = 1, N + a(i) = 3.14d0 + !ERROR: GOTO to a label outside of a KERNELS construct is not allowed + if (i == N-1) goto 998 + end do + !$acc end kernels +998 continue + + !$acc serial + do i = 1, N + a(i) = 3.14d0 + !ERROR: GOTO to a label outside of a SERIAL construct is not allowed + if (i == N-1) goto 997 + end do + !$acc end serial +997 continue + + ! GOTO within a compute construct is allowed. + !$acc parallel + do i = 1, N + if (i == N-1) goto 996 +996 a(i) = 3.14d0 + end do + !$acc end parallel + + ! GOTO out of a data construct is allowed. + !$acc data create(a) + do i = 1, N + if (i == N-1) goto 995 + end do + !$acc end data +995 continue + end subroutine openacc_clause_validity