diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp --- a/flang/lib/Semantics/check-acc-structure.cpp +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -134,9 +134,30 @@ } void AccStructureChecker::Leave( - const parser::OpenACCStandaloneDeclarativeConstruct &) { + const parser::OpenACCStandaloneDeclarativeConstruct &x) { // Restriction - line 2409 CheckAtLeastOneClause(); + + // Restriction - line 2417-2418 - In a Fortran module declaration section, + // only create, copyin, device_resident, and link clauses are allowed. + const auto &declarativeDir{std::get(x.t)}; + const auto &scope{context_.FindScope(declarativeDir.source)}; + const Scope &containingScope{GetProgramUnitContaining(scope)}; + if (containingScope.kind() == Scope::Kind::Module) { + for (auto cl : GetContext().actualClauses) { + if (cl != llvm::acc::Clause::ACCC_create && + cl != llvm::acc::Clause::ACCC_copyin && + cl != llvm::acc::Clause::ACCC_device_resident && + cl != llvm::acc::Clause::ACCC_link) + context_.Say(GetContext().directiveSource, + "%s clause is not allowed on the %s directive in module " + "declaration " + "section"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCClauseName(cl).str()), + ContextDirectiveAsFortran()); + } + } dirContext_.pop_back(); } diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -124,6 +124,7 @@ bool Pre(const parser::OpenACCRoutineConstruct &); bool Pre(const parser::AccBindClause &); + void Post(const parser::OpenACCStandaloneDeclarativeConstruct &); void Post(const parser::AccBeginBlockDirective &) { GetContext().withinConstruct = true; @@ -215,6 +216,7 @@ void CheckMultipleAppearances( const parser::Name &, const Symbol &, Symbol::Flag); void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList); + void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList); }; // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct @@ -470,6 +472,60 @@ return true; } +static const parser::AccObjectList &GetAccObjectList( + const parser::AccClause &clause) { + if (const auto *copyClause = + std::get_if(&clause.u)) { + return copyClause->v; + } else if (const auto *createClause = + std::get_if(&clause.u)) { + const Fortran::parser::AccObjectListWithModifier &listWithModifier = + createClause->v; + const Fortran::parser::AccObjectList &accObjectList = + std::get(listWithModifier.t); + return accObjectList; + } else if (const auto *copyinClause = + std::get_if(&clause.u)) { + const Fortran::parser::AccObjectListWithModifier &listWithModifier = + copyinClause->v; + const Fortran::parser::AccObjectList &accObjectList = + std::get(listWithModifier.t); + return accObjectList; + } else if (const auto *copyoutClause = + std::get_if(&clause.u)) { + const Fortran::parser::AccObjectListWithModifier &listWithModifier = + copyoutClause->v; + const Fortran::parser::AccObjectList &accObjectList = + std::get(listWithModifier.t); + return accObjectList; + } else if (const auto *presentClause = + std::get_if(&clause.u)) { + return presentClause->v; + } else if (const auto *deviceptrClause = + std::get_if( + &clause.u)) { + return deviceptrClause->v; + } else if (const auto *deviceResidentClause = + std::get_if( + &clause.u)) { + return deviceResidentClause->v; + } else if (const auto *linkClause = + std::get_if(&clause.u)) { + return linkClause->v; + } else { + llvm_unreachable("Clause without object list!"); + } +} + +void AccAttributeVisitor::Post( + const parser::OpenACCStandaloneDeclarativeConstruct &x) { + const auto &clauseList = std::get(x.t); + for (const auto &clause : clauseList.v) { + // Restriction - line 2414 + DoNotAllowAssumedSizedArray(GetAccObjectList(clause)); + } +} + bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) { const auto &beginDir{std::get(x.t)}; const auto &loopDir{std::get(beginDir.t)}; @@ -588,6 +644,30 @@ } } +void AccAttributeVisitor::DoNotAllowAssumedSizedArray( + const parser::AccObjectList &objectList) { + for (const auto &accObject : objectList.v) { + std::visit( + common::visitors{ + [&](const parser::Designator &designator) { + const auto &name{GetLastName(designator)}; + if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) + context_.Say(designator.source, + "Assumed-size dummy arrays may not appear on the %s " + "directive"_err_en_US, + parser::ToUpperCaseLetters( + llvm::acc::getOpenACCDirectiveName( + GetContext().directive) + .str())); + }, + [&](const auto &name) { + + }, + }, + accObject.u); + } +} + bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) { const auto &verbatim{std::get(x.t)}; PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache); diff --git a/flang/test/Semantics/acc-clause-validity.f90 b/flang/test/Semantics/acc-clause-validity.f90 --- a/flang/test/Semantics/acc-clause-validity.f90 +++ b/flang/test/Semantics/acc-clause-validity.f90 @@ -7,7 +7,6 @@ ! 2.5.3 Kernels ! 2.9 Loop ! 2.12 Atomic -! 2.13 Declare ! 2.14.3 Set ! 2.14.4 Update ! 2.15.1 Routine @@ -42,8 +41,6 @@ type(atype) :: t type(atype), dimension(10) :: ta - !ERROR: At least one clause is required on the DECLARE directive - !$acc declare real(8), dimension(N) :: a, f, g, h !$acc init diff --git a/flang/test/Semantics/acc-declare-validity.f90 b/flang/test/Semantics/acc-declare-validity.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/acc-declare-validity.f90 @@ -0,0 +1,57 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenacc + +! Check OpenACC clause validity for the following construct and directive: +! 2.13 Declare + +module openacc_declare_validity + + implicit none + + real(8), dimension(10) :: aa, bb, ab, cc + + !ERROR: At least one clause is required on the DECLARE directive + !$acc declare + + !$acc declare create(aa, bb) + + !$acc declare link(ab) + + !$acc declare device_resident(cc) + + !ERROR: COPYOUT clause is not allowed on the DECLARE directive in module declaration section + !$acc declare copyout(ab) + + !ERROR: COPY clause is not allowed on the DECLARE directive in module declaration section + !$acc declare copy(ab) + + !ERROR: PRESENT clause is not allowed on the DECLARE directive in module declaration section + !$acc declare present(ab) + + !ERROR: DEVICEPTR clause is not allowed on the DECLARE directive in module declaration section + !$acc declare deviceptr(ab) + +contains + + subroutine sub1(cc, dd) + real(8) :: cc(:) + real(8) :: dd(:) + !$acc declare present(cc, dd) + end subroutine sub1 + + function fct1(ee, ff, gg, hh, ii) + integer :: fct1 + real(8), intent(in) :: ee(:) + !$acc declare copyin(readonly: ee) + real(8) :: ff(:), hh(:), ii(:,:) + !$acc declare link(hh) device_resident(ii) + real(8), intent(out) :: gg(:) + !$acc declare copy(ff) copyout(gg) + end function fct1 + + subroutine sub2(cc) + real(8), dimension(*) :: cc + !ERROR: Assumed-size dummy arrays may not appear on the DECLARE directive + !$acc declare present(cc) + end subroutine sub2 + +end module openacc_declare_validity