diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -2,8 +2,10 @@ add_flang_library(FortranSemantics assignment.cpp attr.cpp + canonicalize-acc.cpp canonicalize-do.cpp canonicalize-omp.cpp + check-acc-structure.cpp check-allocate.cpp check-arithmeticif.cpp check-call.cpp diff --git a/flang/lib/Semantics/canonicalize-acc.h b/flang/lib/Semantics/canonicalize-acc.h new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/canonicalize-acc.h @@ -0,0 +1,21 @@ +//===-- lib/Semantics/canonicalize-acc.h ------------------------*- C++ -*-===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_SEMANTICS_CANONICALIZE_ACC_H_ +#define FORTRAN_SEMANTICS_CANONICALIZE_ACC_H_ + +namespace Fortran::parser { +struct Program; +class Messages; +} // namespace Fortran::parser + +namespace Fortran::semantics { +bool CanonicalizeAcc(parser::Messages &messages, parser::Program &program); +} + +#endif // FORTRAN_SEMANTICS_CANONICALIZE_ACC_H_ \ No newline at end of file diff --git a/flang/lib/Semantics/canonicalize-acc.cpp b/flang/lib/Semantics/canonicalize-acc.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/canonicalize-acc.cpp @@ -0,0 +1,96 @@ +//===-- lib/Semantics/canonicalize-acc.cpp --------------------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "canonicalize-acc.h" +#include "flang/Parser/parse-tree-visitor.h" + +// After Loop Canonicalization, rewrite OpenACC parse tree to make OpenACC +// Constructs more structured which provide explicit scopes for later +// structural checks and semantic analysis. +// 1. move structured DoConstruct into +// OpenACCLoopConstruct. Compilation will not proceed in case of errors +// after this pass. +namespace Fortran::semantics { + +using namespace parser::literals; + +class CanonicalizationOfAcc { +public: + template bool Pre(T &) { return true; } + template void Post(T &) {} + CanonicalizationOfAcc(parser::Messages &messages) : messages_{messages} {} + + void Post(parser::Block &block) { + for (auto it{block.begin()}; it != block.end(); ++it) { + if (auto *accCons{GetConstructIf(*it)}) { + // OpenACCLoopConstruct + if (auto *accLoop{ + std::get_if(&accCons->u)}) { + RewriteOpenACCLoopConstruct(*accLoop, block, it); + } + } + } // Block list + } + +private: + template T *GetConstructIf(parser::ExecutionPartConstruct &x) { + if (auto *y{std::get_if(&x.u)}) { + if (auto *z{std::get_if>(&y->u)}) { + return &z->value(); + } + } + return nullptr; + } + + 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(x.t)}; + auto &dir{std::get(beginDir.t)}; + + nextIt = it; + if (++nextIt != block.end()) { + if (auto *doCons{GetConstructIf(*nextIt)}) { + if (doCons->GetLoopControl()) { + // move DoConstruct + std::get>(x.t) = + std::move(*doCons); + nextIt = block.erase(nextIt); + } else { + messages_.Say(dir.source, + "DO loop after the %s directive must have loop control"_err_en_US, + parser::ToUpperCaseLetters(dir.source.ToString())); + } + 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::Messages &messages_; +}; + +bool CanonicalizeAcc(parser::Messages &messages, parser::Program &program) { + CanonicalizationOfAcc acc{messages}; + Walk(program, acc); + return !messages.AnyFatalError(); +} +} // namespace Fortran::semantics \ No newline at end of file diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/check-acc-structure.h @@ -0,0 +1,206 @@ +//===-- lib/Semantics/check-acc-structure.h ---------------------*- C++ -*-===// +// +// 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 structure validity check list +// 1. invalid clauses on directive +// 2. invalid repeated clauses on directive +// 3. invalid nesting of regions +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_SEMANTICS_CHECK_ACC_STRUCTURE_H_ +#define FORTRAN_SEMANTICS_CHECK_ACC_STRUCTURE_H_ + +#include "flang/Common/enum-set.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/semantics.h" +#include "llvm/Frontend/OpenACC/ACC.h.inc" + +#include + +using AccDirectiveSet = Fortran::common::EnumSet; + +using AccClauseSet = + Fortran::common::EnumSet; + +#define GEN_FLANG_DIRECTIVE_CLAUSE_SETS +#include "llvm/Frontend/OpenACC/ACC.cpp.inc" + +namespace Fortran::semantics { + +class AccStructureChecker : public virtual BaseChecker { +public: + AccStructureChecker(SemanticsContext &context) : context_{context} {} + + // Construct and directives + void Enter(const parser::OpenACCBlockConstruct &); + void Leave(const parser::OpenACCBlockConstruct &); + void Enter(const parser::OpenACCConstruct &); + void Enter(const parser::OpenACCCombinedConstruct &); + void Leave(const parser::OpenACCCombinedConstruct &); + void Enter(const parser::OpenACCDeclarativeConstruct &); + void Enter(const parser::OpenACCLoopConstruct &); + void Leave(const parser::OpenACCLoopConstruct &); + void Enter(const parser::OpenACCRoutineConstruct &); + void Leave(const parser::OpenACCRoutineConstruct &); + void Enter(const parser::OpenACCStandaloneConstruct &); + void Leave(const parser::OpenACCStandaloneConstruct &); + void Enter(const parser::OpenACCStandaloneDeclarativeConstruct &); + void Leave(const parser::OpenACCStandaloneDeclarativeConstruct &); + + // Clauses + void Leave(const parser::AccClauseList &); + void Enter(const parser::AccClause &); + + void Enter(const parser::AccClause::Auto &); + void Enter(const parser::AccClause::Async &); + void Enter(const parser::AccClause::Attach &); + void Enter(const parser::AccClause::Bind &); + void Enter(const parser::AccClause::Capture &); + void Enter(const parser::AccClause::Create &); + void Enter(const parser::AccClause::Collapse &); + void Enter(const parser::AccClause::Copy &); + void Enter(const parser::AccClause::Copyin &); + void Enter(const parser::AccClause::Copyout &); + void Enter(const parser::AccClause::Default &); + void Enter(const parser::AccClause::DefaultAsync &); + void Enter(const parser::AccClause::Delete &); + void Enter(const parser::AccClause::Detach &); + void Enter(const parser::AccClause::Device &); + void Enter(const parser::AccClause::DeviceNum &); + void Enter(const parser::AccClause::DevicePtr &); + void Enter(const parser::AccClause::DeviceResident &); + void Enter(const parser::AccClause::DeviceType &); + void Enter(const parser::AccClause::Finalize &); + void Enter(const parser::AccClause::FirstPrivate &); + void Enter(const parser::AccClause::Gang &); + void Enter(const parser::AccClause::Host &); + void Enter(const parser::AccClause::If &); + void Enter(const parser::AccClause::IfPresent &); + void Enter(const parser::AccClause::Independent &); + void Enter(const parser::AccClause::Link &); + void Enter(const parser::AccClause::NoCreate &); + void Enter(const parser::AccClause::NoHost &); + void Enter(const parser::AccClause::NumGangs &); + void Enter(const parser::AccClause::NumWorkers &); + void Enter(const parser::AccClause::Present &); + void Enter(const parser::AccClause::Private &); + void Enter(const parser::AccClause::Read &); + void Enter(const parser::AccClause::Reduction &); + void Enter(const parser::AccClause::Self &); + void Enter(const parser::AccClause::Seq &); + void Enter(const parser::AccClause::Tile &); + void Enter(const parser::AccClause::UseDevice &); + void Enter(const parser::AccClause::Vector &); + void Enter(const parser::AccClause::VectorLength &); + void Enter(const parser::AccClause::Wait &); + void Enter(const parser::AccClause::Worker &); + void Enter(const parser::AccClause::Write &); + +private: +#define GEN_FLANG_DIRECTIVE_CLAUSE_MAP +#include "llvm/Frontend/OpenACC/ACC.cpp.inc" + + struct AccContext { + AccContext(parser::CharBlock source, llvm::acc::Directive d) + : directiveSource{source}, directive{d} {} + + parser::CharBlock directiveSource{nullptr}; + parser::CharBlock clauseSource{nullptr}; + llvm::acc::Directive directive; + AccClauseSet allowedClauses{}; + AccClauseSet allowedOnceClauses{}; + AccClauseSet allowedExclusiveClauses{}; + AccClauseSet requiredClauses{}; + + const parser::AccClause *clause{nullptr}; + std::multimap clauseInfo; + std::list actualClauses; + }; + + // back() is the top of the stack + AccContext &GetContext() { + CHECK(!accContext_.empty()); + return accContext_.back(); + } + + void SetContextClause(const parser::AccClause &clause) { + GetContext().clauseSource = clause.source; + GetContext().clause = &clause; + } + + void SetContextClauseInfo(llvm::acc::Clause type) { + GetContext().clauseInfo.emplace(type, GetContext().clause); + } + + void AddClauseToCrtContext(llvm::acc::Clause type) { + GetContext().actualClauses.push_back(type); + } + + const parser::AccClause *FindClause(llvm::acc::Clause type) { + auto it{GetContext().clauseInfo.find(type)}; + if (it != GetContext().clauseInfo.end()) { + return it->second; + } + return nullptr; + } + + void PushContext(const parser::CharBlock &source, llvm::acc::Directive dir) { + accContext_.emplace_back(source, dir); + } + + void SetClauseSets(llvm::acc::Directive dir) { + accContext_.back().allowedClauses = directiveClausesTable[dir].allowed; + accContext_.back().allowedOnceClauses = + directiveClausesTable[dir].allowedOnce; + accContext_.back().allowedExclusiveClauses = + directiveClausesTable[dir].allowedExclusive; + accContext_.back().requiredClauses = + directiveClausesTable[dir].requiredOneOf; + } + void PushContextAndClauseSets( + const parser::CharBlock &source, llvm::acc::Directive dir) { + PushContext(source, dir); + SetClauseSets(dir); + } + + void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &); + + template void CheckMatching(const B &beginDir, const B &endDir) { + const auto &begin{beginDir.v}; + const auto &end{endDir.v}; + if (begin != end) { + SayNotMatching(beginDir.source, endDir.source); + } + } + + // Check that only clauses in set are after the specific clauses. + void CheckOnlyAllowedAfter(llvm::acc::Clause clause, AccClauseSet set); + void CheckRequireAtLeastOneOf(); + void CheckAllowed(llvm::acc::Clause clause); + void CheckAtLeastOneClause(); + void CheckNotAllowedIfClause(llvm::acc::Clause clause, AccClauseSet set); + std::string ContextDirectiveAsFortran(); + + void CheckNoBranching(const parser::Block &block, + const llvm::acc::Directive directive, + const parser::CharBlock &directiveSource) const; + + void RequiresConstantPositiveParameter( + const llvm::acc::Clause &clause, const parser::ScalarIntConstantExpr &i); + void OptionalConstantPositiveParameter(const llvm::acc::Clause &clause, + const std::optional &o); + + SemanticsContext &context_; + std::vector accContext_; // used as a stack + + std::string ClauseSetToString(const AccClauseSet set); +}; + +} // namespace Fortran::semantics + +#endif // FORTRAN_SEMANTICS_CHECK_ACC_STRUCTURE_H_ \ No newline at end of file diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -0,0 +1,513 @@ +//===-- lib/Semantics/check-acc-structure.cpp -----------------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "check-acc-structure.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/tools.h" + +#define CHECK_SIMPLE_CLAUSE(X, Y) \ + void AccStructureChecker::Enter(const parser::AccClause::X &) { \ + CheckAllowed(llvm::acc::Clause::Y); \ + } + +#define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \ + void AccStructureChecker::Enter(const parser::AccClause::X &c) { \ + CheckAllowed(llvm::acc::Clause::Y); \ + RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \ + } + +namespace Fortran::semantics { + +static constexpr inline AccClauseSet + parallelAndKernelsOnlyAllowedAfterDeviceTypeClauses{ + llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait, + llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers, + llvm::acc::Clause::ACCC_vector_length}; + +static constexpr inline AccClauseSet serialOnlyAllowedAfterDeviceTypeClauses{ + llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait}; + +static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{ + llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse, + llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang, + llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile, + llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker}; + +static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{ + llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait}; + +static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{ + llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang, + llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker}; + +class NoBranchingEnforce { +public: + NoBranchingEnforce(SemanticsContext &context, + parser::CharBlock sourcePosition, llvm::acc::Directive directive) + : context_{context}, sourcePosition_{sourcePosition}, currentDirective_{ + directive} {} + template bool Pre(const T &) { return true; } + template void Post(const T &) {} + + template bool Pre(const parser::Statement &statement) { + currentStatementSourcePosition_ = statement.source; + return true; + } + + void Post(const parser::ReturnStmt &) { emitBranchOutError("RETURN"); } + void Post(const parser::ExitStmt &) { emitBranchOutError("EXIT"); } + void Post(const parser::StopStmt &) { emitBranchOutError("STOP"); } + +private: + parser::MessageFixedText GetEnclosingMsg() { + return "Enclosing block construct"_en_US; + } + + void emitBranchOutError(const char *stmt) { + context_ + .Say(currentStatementSourcePosition_, + "%s statement is not allowed in a %s construct"_err_en_US, stmt, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCDirectiveName(currentDirective_).str())) + .Attach(sourcePosition_, GetEnclosingMsg()); + } + + SemanticsContext &context_; + parser::CharBlock currentStatementSourcePosition_; + parser::CharBlock sourcePosition_; + llvm::acc::Directive currentDirective_; +}; + +void AccStructureChecker::Enter(const parser::OpenACCConstruct &) { return; } + +void AccStructureChecker::Enter(const parser::OpenACCDeclarativeConstruct &) { + return; +} + +void AccStructureChecker::Enter(const parser::AccClause &x) { + SetContextClause(x); +} + +void AccStructureChecker::Leave(const parser::AccClauseList &) {} + +void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) { + const auto &beginBlockDir{std::get(x.t)}; + const auto &endBlockDir{std::get(x.t)}; + const auto &beginAccBlockDir{ + std::get(beginBlockDir.t)}; + + CheckMatching(beginAccBlockDir, endBlockDir.v); + PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v); +} + +void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) { + const auto &beginBlockDir{std::get(x.t)}; + const auto &blockDir{std::get(beginBlockDir.t)}; + const parser::Block &block{std::get(x.t)}; + switch (blockDir.v) { + case llvm::acc::Directive::ACCD_kernels: + case llvm::acc::Directive::ACCD_parallel: { + // Restriction - 880-881 (KERNELS) + // Restriction - 843-844 (PARALLEL) + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + parallelAndKernelsOnlyAllowedAfterDeviceTypeClauses); + // Restriction - 877 (KERNELS) + // Restriction - 840 (PARALLEL) + CheckNoBranching(block, GetContext().directive, blockDir.source); + } break; + case llvm::acc::Directive::ACCD_serial: { + // Restriction - 919 + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + serialOnlyAllowedAfterDeviceTypeClauses); + // Restriction - 916 + CheckNoBranching(block, llvm::acc::Directive::ACCD_serial, blockDir.source); + } break; + case llvm::acc::Directive::ACCD_data: { + // Restriction - 1117-1118 + CheckRequireAtLeastOneOf(); + } break; + case llvm::acc::Directive::ACCD_host_data: { + // Restriction - 1578 + CheckRequireAtLeastOneOf(); + } break; + default: + break; + } + accContext_.pop_back(); +} + +void AccStructureChecker::CheckNoBranching(const parser::Block &block, + const llvm::acc::Directive directive, + const parser::CharBlock &directiveSource) const { + NoBranchingEnforce noBranchingEnforce{context_, directiveSource, directive}; + parser::Walk(block, noBranchingEnforce); +} + +void AccStructureChecker::Enter( + const parser::OpenACCStandaloneDeclarativeConstruct &x) { + const auto &declarativeDir{std::get(x.t)}; + PushContextAndClauseSets(declarativeDir.source, declarativeDir.v); +} + +void AccStructureChecker::Leave( + const parser::OpenACCStandaloneDeclarativeConstruct &) { + // Restriction - 2075 + CheckAtLeastOneClause(); + accContext_.pop_back(); +} + +void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) { + const auto &beginBlockDir{std::get(x.t)}; + const auto &combinedDir{ + std::get(beginBlockDir.t)}; + PushContextAndClauseSets(combinedDir.source, combinedDir.v); +} + +void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) { + const auto &beginBlockDir{std::get(x.t)}; + const auto &combinedDir{ + std::get(beginBlockDir.t)}; + switch (combinedDir.v) { + case llvm::acc::Directive::ACCD_kernels_loop: + case llvm::acc::Directive::ACCD_parallel_loop: { + // Restriction - 1962 -> (880-881) (KERNELS LOOP) + // Restriction - 1962 -> (843-844) (PARALLEL LOOP) + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + {llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait, + llvm::acc::Clause::ACCC_num_gangs, + llvm::acc::Clause::ACCC_num_workers, + llvm::acc::Clause::ACCC_vector_length}); + } break; + case llvm::acc::Directive::ACCD_serial_loop: { + // Restriction - 1962 -> (919) (SERIAL LOOP) + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + {llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait}); + } break; + default: + break; + } + accContext_.pop_back(); +} + +std::string AccStructureChecker::ContextDirectiveAsFortran() { + return parser::ToUpperCaseLetters( + llvm::acc::getOpenACCDirectiveName(GetContext().directive).str()); +} + +void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) { + const auto &beginDir{std::get(x.t)}; + const auto &loopDir{std::get(beginDir.t)}; + PushContextAndClauseSets(loopDir.source, loopDir.v); +} + +void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) { + const auto &beginDir{std::get(x.t)}; + const auto &loopDir{std::get(beginDir.t)}; + switch (loopDir.v) { + case llvm::acc::Directive::ACCD_loop: { + // Restriction - 1615-1616 + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + loopOnlyAllowedAfterDeviceTypeClauses); + // Restriction - 1622 + CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq, + {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector, + llvm::acc::Clause::ACCC_worker}); + } break; + default: { + } break; + } + accContext_.pop_back(); +} + +void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) { + const auto &standaloneDir{std::get(x.t)}; + PushContextAndClauseSets(standaloneDir.source, standaloneDir.v); +} + +void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) { + const auto &standaloneDir{std::get(x.t)}; + switch (standaloneDir.v) { + case llvm::acc::Directive::ACCD_enter_data: + case llvm::acc::Directive::ACCD_exit_data: + case llvm::acc::Directive::ACCD_set: { + // Restriction - 1117-1118 (ENTER DATA) + // Restriction - 1161-1162 (EXIT DATA) + // Restriction - 2254 (SET) + CheckRequireAtLeastOneOf(); + } break; + case llvm::acc::Directive::ACCD_update: { + // Restriction - 2301 + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + updateOnlyAllowedAfterDeviceTypeClauses); + } break; + default: { + } break; + } + accContext_.pop_back(); +} + +void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) { + PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine); +} +void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) { + // Restriction - 2409 + CheckRequireAtLeastOneOf(); + // Restriction - 2407-2408 + CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type, + routineOnlyAllowedAfterDeviceTypeClauses); + accContext_.pop_back(); +} + +// Clause checkers +CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(Collapse, ACCC_collapse) + +CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto) +CHECK_SIMPLE_CLAUSE(Async, ACCC_async) +CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach) +CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind) +CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture) +CHECK_SIMPLE_CLAUSE(Copy, ACCC_copy) +CHECK_SIMPLE_CLAUSE(Default, ACCC_default) +CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async) +CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete) +CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach) +CHECK_SIMPLE_CLAUSE(Device, ACCC_device) +CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num) +CHECK_SIMPLE_CLAUSE(DevicePtr, ACCC_deviceptr) +CHECK_SIMPLE_CLAUSE(DeviceResident, ACCC_device_resident) +CHECK_SIMPLE_CLAUSE(DeviceType, ACCC_device_type) +CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize) +CHECK_SIMPLE_CLAUSE(FirstPrivate, ACCC_firstprivate) +CHECK_SIMPLE_CLAUSE(Gang, ACCC_gang) +CHECK_SIMPLE_CLAUSE(Host, ACCC_host) +CHECK_SIMPLE_CLAUSE(If, ACCC_if) +CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present) +CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent) +CHECK_SIMPLE_CLAUSE(Link, ACCC_link) +CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create) +CHECK_SIMPLE_CLAUSE(NoHost, ACCC_nohost) +CHECK_SIMPLE_CLAUSE(NumGangs, ACCC_num_gangs) +CHECK_SIMPLE_CLAUSE(NumWorkers, ACCC_num_workers) +CHECK_SIMPLE_CLAUSE(Present, ACCC_present) +CHECK_SIMPLE_CLAUSE(Private, ACCC_private) +CHECK_SIMPLE_CLAUSE(Read, ACCC_read) +CHECK_SIMPLE_CLAUSE(Reduction, ACCC_reduction) +CHECK_SIMPLE_CLAUSE(Self, ACCC_self) +CHECK_SIMPLE_CLAUSE(Seq, ACCC_seq) +CHECK_SIMPLE_CLAUSE(Tile, ACCC_tile) +CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device) +CHECK_SIMPLE_CLAUSE(Vector, ACCC_vector) +CHECK_SIMPLE_CLAUSE(VectorLength, ACCC_vector_length) +CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait) +CHECK_SIMPLE_CLAUSE(Worker, ACCC_worker) +CHECK_SIMPLE_CLAUSE(Write, ACCC_write) + +void AccStructureChecker::Enter(const parser::AccClause::Create &c) { + CheckAllowed(llvm::acc::Clause::ACCC_create); + const auto &modifierClause{c.v}; + if (const auto &modifier{ + std::get>(modifierClause.t)}) { + if (modifier->v != parser::AccDataModifier::Modifier::Zero) { + context_.Say(GetContext().clauseSource, + "Only the ZERO modifier is allowed for the %s clause " + "on the %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create) + .str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) { + CheckAllowed(llvm::acc::Clause::ACCC_copyin); + const auto &modifierClause{c.v}; + if (const auto &modifier{ + std::get>(modifierClause.t)}) { + if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) { + context_.Say(GetContext().clauseSource, + "Only the READONLY modifier is allowed for the %s clause " + "on the %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin) + .str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) { + CheckAllowed(llvm::acc::Clause::ACCC_copyout); + const auto &modifierClause{c.v}; + if (const auto &modifier{ + std::get>(modifierClause.t)}) { + if (modifier->v != parser::AccDataModifier::Modifier::Zero) { + context_.Say(GetContext().clauseSource, + "Only the ZERO modifier is allowed for the %s clause " + "on the %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout) + .str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::CheckAllowed(llvm::acc::Clause clause) { + if (!GetContext().allowedClauses.test(clause) && + !GetContext().allowedOnceClauses.test(clause) && + !GetContext().allowedExclusiveClauses.test(clause) && + !GetContext().requiredClauses.test(clause)) { + context_.Say(GetContext().clauseSource, + "%s clause is not allowed on the %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + parser::ToUpperCaseLetters(GetContext().directiveSource.ToString())); + return; + } + if ((GetContext().allowedOnceClauses.test(clause) || + GetContext().allowedExclusiveClauses.test(clause)) && + FindClause(clause)) { + context_.Say(GetContext().clauseSource, + "At most one %s clause can appear on the %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + parser::ToUpperCaseLetters(GetContext().directiveSource.ToString())); + return; + } + if (GetContext().allowedExclusiveClauses.test(clause)) { + std::vector others; + GetContext().allowedExclusiveClauses.IterateOverMembers( + [&](llvm::acc::Clause o) { + if (FindClause(o)) { + others.emplace_back(o); + } + }); + for (const auto &e : others) { + context_.Say(GetContext().clauseSource, + "%s and %s clauses are mutually exclusive and may not appear on the " + "same %s directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + parser::ToUpperCaseLetters(llvm::acc::getOpenACCClauseName(e).str()), + parser::ToUpperCaseLetters(GetContext().directiveSource.ToString())); + } + if (!others.empty()) { + return; + } + } + SetContextClauseInfo(clause); + AddClauseToCrtContext(clause); +} + +void AccStructureChecker::CheckOnlyAllowedAfter( + llvm::acc::Clause clause, AccClauseSet set) { + bool enforceCheck = false; + for (auto cl : GetContext().actualClauses) { + if (cl == clause) { + enforceCheck = true; + continue; + } else if (enforceCheck && !set.test(cl)) { + auto parserClause = GetContext().clauseInfo.find(cl); + context_.Say(parserClause->second->source, + "Clause %s is not allowed after clause %s on the %s " + "directive"_err_en_US, + parser::ToUpperCaseLetters(llvm::acc::getOpenACCClauseName(cl).str()), + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::CheckRequireAtLeastOneOf() { + for (auto cl : GetContext().actualClauses) { + if (GetContext().requiredClauses.test(cl)) + return; + } + // No clause matched in the actual clauses list + context_.Say(GetContext().directiveSource, + "At least one of %s clause must appear on the %s directive"_err_en_US, + ClauseSetToString(GetContext().requiredClauses), + ContextDirectiveAsFortran()); +} + +void AccStructureChecker::CheckAtLeastOneClause() { + if (GetContext().actualClauses.empty()) { + context_.Say(GetContext().directiveSource, + "At least one clause is required on the %s directive"_err_en_US, + ContextDirectiveAsFortran()); + } +} + +/** + * Enforce restriction where clauses in the given set are not allowed if the + * given clause appears. + */ +void AccStructureChecker::CheckNotAllowedIfClause( + llvm::acc::Clause clause, AccClauseSet set) { + if (std::find(GetContext().actualClauses.begin(), + GetContext().actualClauses.end(), + clause) == GetContext().actualClauses.end()) { + return; // Clause is not present + } + + for (auto cl : GetContext().actualClauses) { + if (set.test(cl)) { + context_.Say(GetContext().directiveSource, + "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US, + parser::ToUpperCaseLetters(llvm::acc::getOpenACCClauseName(cl).str()), + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::RequiresConstantPositiveParameter( + const llvm::acc::Clause &clause, const parser::ScalarIntConstantExpr &i) { + if (const auto v{GetIntValue(i)}) { + if (*v <= 0) { + context_.Say(GetContext().clauseSource, + "The parameter of the %s clause on the %s directive must be " + "a constant positive integer expression"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(clause).str()), + ContextDirectiveAsFortran()); + } + } +} + +void AccStructureChecker::OptionalConstantPositiveParameter( + const llvm::acc::Clause &clause, + const std::optional &o) { + if (o != std::nullopt) { + RequiresConstantPositiveParameter(clause, o.value()); + } +} + +std::string AccStructureChecker::ClauseSetToString(const AccClauseSet set) { + std::string list; + set.IterateOverMembers([&](llvm::acc::Clause o) { + if (!list.empty()) + list.append(", "); + list.append( + parser::ToUpperCaseLetters(llvm::acc::getOpenACCClauseName(o).str())); + }); + return list; +} + +void AccStructureChecker::SayNotMatching( + const parser::CharBlock &beginSource, const parser::CharBlock &endSource) { + context_ + .Say(endSource, "Unmatched %s directive"_err_en_US, + parser::ToUpperCaseLetters(endSource.ToString())) + .Attach(beginSource, "Does not match directive"_en_US); +} + +} // namespace Fortran::semantics \ No newline at end of file diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -8,8 +8,10 @@ #include "flang/Semantics/semantics.h" #include "assignment.h" +#include "canonicalize-acc.h" #include "canonicalize-do.h" #include "canonicalize-omp.h" +#include "check-acc-structure.h" #include "check-allocate.h" #include "check-arithmeticif.h" #include "check-case.h" @@ -154,12 +156,12 @@ }; using StatementSemanticsPass1 = ExprChecker; -using StatementSemanticsPass2 = SemanticsVisitor; +using StatementSemanticsPass2 = SemanticsVisitor; static bool PerformStatementSemantics( SemanticsContext &context, parser::Program &program) { @@ -325,6 +327,7 @@ bool Semantics::Perform() { return ValidateLabels(context_, program_) && parser::CanonicalizeDo(program_) && // force line break + CanonicalizeAcc(context_.messages(), program_) && CanonicalizeOmp(context_.messages(), program_) && PerformStatementSemantics(context_, program_) && ModFileWriter{context_}.WriteAll(); diff --git a/flang/test/Semantics/acc-branch.f90 b/flang/test/Semantics/acc-branch.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/acc-branch.f90 @@ -0,0 +1,101 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenacc + +! Check OpenACC restruction in branch in and out of some construct +! + +program openacc_clause_validity + + implicit none + + integer :: i + integer :: N = 256 + real(8) :: a(256) + + !$acc parallel + !$acc loop + do i = 1, N + a(i) = 3.14 + !ERROR: RETURN statement is not allowed in a PARALLEL construct + return + end do + !$acc end parallel + + !$acc parallel + !$acc loop + 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 + + !$acc parallel + !$acc loop + do i = 1, N + a(i) = 3.14 + if(i == N-1) THEN + !ERROR: STOP statement is not allowed in a PARALLEL construct + stop 999 + end if + end do + !$acc end parallel + + !$acc kernels + do i = 1, N + a(i) = 3.14 + !ERROR: RETURN statement is not allowed in a KERNELS construct + return + end do + !$acc end kernels + + !$acc kernels + 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 + !$acc end kernels + + !$acc kernels + do i = 1, N + a(i) = 3.14 + if(i == N-1) THEN + !ERROR: STOP statement is not allowed in a KERNELS construct + stop 999 + end if + end do + !$acc end kernels + + !$acc serial + do i = 1, N + a(i) = 3.14 + !ERROR: RETURN statement is not allowed in a SERIAL construct + return + end do + !$acc end serial + + !$acc serial + 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 + + !$acc serial + do i = 1, N + a(i) = 3.14 + if(i == N-1) THEN + !ERROR: STOP statement is not allowed in a SERIAL construct + stop 999 + end if + end do + !$acc end serial + +end program openacc_clause_validity diff --git a/flang/test/Semantics/acc-validity.f90 b/flang/test/Semantics/acc-clause-validity.f90 rename from flang/test/Semantics/acc-validity.f90 rename to flang/test/Semantics/acc-clause-validity.f90 --- a/flang/test/Semantics/acc-validity.f90 +++ b/flang/test/Semantics/acc-clause-validity.f90 @@ -16,31 +16,41 @@ integer :: i, j integer :: N = 256 - + !ERROR: At least one clause is required on the DECLARE directive !$acc declare real(8) :: a(256) + !ERROR: At least one of ATTACH, COPYIN, CREATE clause must appear on the ENTER DATA directive !$acc enter data + !ERROR: Only the READONLY modifier is allowed for the COPYIN clause on the ENTER DATA directive !$acc enter data copyin(zero: i) + !ERROR: Only the ZERO modifier is allowed for the CREATE clause on the ENTER DATA directive !$acc enter data create(readonly: i) + !ERROR: Only the ZERO modifier is allowed for the COPYOUT clause on the DATA directive !$acc data copyout(readonly: i) !$acc end data + !ERROR: COPYOUT clause is not allowed on the ENTER DATA directive !$acc enter data copyin(i) copyout(i) + !ERROR: At most one IF clause can appear on the DATA directive !$acc data copy(i) if(.true.) if(.true.) !$acc end data + !ERROR: At least one of COPYOUT, DELETE, DETACH clause must appear on the EXIT DATA directive !$acc exit data + !ERROR: At least one of USE_DEVICE clause must appear on the HOST_DATA directive !$acc host_data !$acc end host_data + !ERROR: At least one of DEFAULT_ASYNC, DEVICE_NUM, DEVICE_TYPE clause must appear on the SET directive !$acc set + !ERROR: At least one of ATTACH, COPY, COPYIN, COPYOUT, CREATE, DEFAULT, DEVICEPTR, NO_CREATE, PRESENT clause must appear on the DATA directive !$acc data !$acc end data @@ -48,16 +58,16 @@ !$acc end data !$acc data copyin(i) - + !ERROR: Unmatched PARALLEL directive !$acc end parallel !$acc update device(i) device_type(*) async - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the UPDATE directive !$acc update device(i) device_type(*) if(.TRUE.) !$acc parallel - + !ERROR: INDEPENDENT and SEQ clauses are mutually exclusive and may not appear on the same LOOP directive !$acc loop seq independent do i = 1, N a(i) = 3.14 @@ -72,7 +82,7 @@ !$acc end parallel !$acc parallel - + !ERROR: The parameter of the COLLAPSE clause on the LOOP directive must be a constant positive integer expression !$acc loop collapse(-1) do i = 1, N do j = 1, N @@ -82,7 +92,7 @@ !$acc end parallel !$acc parallel - + !ERROR: Clause PRIVATE is not allowed after clause DEVICE_TYPE on the LOOP directive !$acc loop device_type(*) private(i) do i = 1, N a(i) = 3.14 @@ -90,14 +100,14 @@ !$acc end parallel !$acc parallel - + !ERROR: Clause GANG is not allowed if clause SEQ appears on the LOOP directive !$acc loop gang seq do i = 1, N a(i) = 3.14 end do !$acc end parallel - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the PARALLEL directive !$acc parallel device_type(*) if(.TRUE.) !$acc loop do i = 1, N @@ -105,7 +115,7 @@ end do !$acc end parallel - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the PARALLEL LOOP directive !$acc parallel loop device_type(*) if(.TRUE.) do i = 1, N a(i) = 3.14 @@ -118,14 +128,14 @@ end do !$acc end kernels - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the KERNELS directive !$acc kernels device_type(*) if(.TRUE.) do i = 1, N a(i) = 3.14 end do !$acc end kernels - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the KERNELS LOOP directive !$acc kernels loop device_type(*) if(.TRUE.) do i = 1, N a(i) = 3.14 @@ -138,14 +148,14 @@ end do !$acc end serial - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the SERIAL directive !$acc serial device_type(*) if(.TRUE.) do i = 1, N a(i) = 3.14 end do !$acc end serial - + !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the SERIAL LOOP directive !$acc serial loop device_type(*) if(.TRUE.) do i = 1, N a(i) = 3.14 @@ -156,14 +166,14 @@ subroutine sub1(a) real :: a(:) - + !ERROR: At least one of GANG, SEQ, VECTOR, WORKER clause must appear on the ROUTINE directive !$acc routine end subroutine sub1 subroutine sub2(a) real :: a(:) - + !ERROR: Clause NOHOST is not allowed after clause DEVICE_TYPE on the ROUTINE directive !$acc routine seq device_type(*) nohost end subroutine sub2 -end program openacc_clause_validity \ No newline at end of file +end program openacc_clause_validity diff --git a/llvm/include/llvm/Frontend/OpenACC/ACC.td b/llvm/include/llvm/Frontend/OpenACC/ACC.td --- a/llvm/include/llvm/Frontend/OpenACC/ACC.td +++ b/llvm/include/llvm/Frontend/OpenACC/ACC.td @@ -103,7 +103,7 @@ } // 2.14.1 -def ACCC_DeviceNum : Clause<"devicenum"> { +def ACCC_DeviceNum : Clause<"device_num"> { let flangClass = "ScalarIntConstantExpr"; } diff --git a/llvm/include/llvm/Frontend/OpenACC/CMakeLists.txt b/llvm/include/llvm/Frontend/OpenACC/CMakeLists.txt --- a/llvm/include/llvm/Frontend/OpenACC/CMakeLists.txt +++ b/llvm/include/llvm/Frontend/OpenACC/CMakeLists.txt @@ -1,4 +1,4 @@ set(LLVM_TARGET_DEFINITIONS ACC.td) tablegen(LLVM ACC.h.inc --gen-directive-decl) -tablegen(LLVM ACC.cpp.inc --gen-directive-impl) +tablegen(LLVM ACC.cpp.inc --gen-directive-gen) add_public_tablegen_target(acc_gen)