diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h index 76157ac93925..44b41c14fc22 100644 --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -139,8 +139,11 @@ protected: const PC *clause{nullptr}; std::multimap clauseInfo; std::list actualClauses; + Symbol *loopIV{nullptr}; }; + void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; } + // back() is the top of the stack DirectiveContext &GetContext() { CHECK(!dirContext_.empty()); @@ -160,6 +163,7 @@ protected: GetContext().allowedExclusiveClauses = {}; GetContext().requiredClauses = {}; GetContext().clauseInfo = {}; + GetContext().loopIV = {nullptr}; } void SetContextDirectiveSource(const parser::CharBlock &directive) { diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 773f5b2aeb21..ff0db2c5182c 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -93,6 +93,22 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { llvm::omp::Directive::OMPD_master}); PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do); } + SetLoopInfo(x); +} +const parser::Name OmpStructureChecker::GetLoopIndex( + const parser::DoConstruct *x) { + using Bounds = parser::LoopControl::Bounds; + return std::get(x->GetLoopControl()->u).name.thing; +} +void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { + if (const auto &loopConstruct{ + std::get>(x.t)}) { + const parser::DoConstruct *loop{&*loopConstruct}; + if (loop && loop->IsDoNormal()) { + const parser::Name &itrVal{GetLoopIndex(loop)}; + SetLoopIv(itrVal.symbol); + } + } } void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) { @@ -124,6 +140,13 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) { CheckMatching(beginDir, endDir); + // TODO: This check needs to be extended while implementing nesting of regions + // checks. + if (beginDir.v == llvm::omp::Directive::OMPD_single) { + HasInvalidWorksharingNesting( + beginDir.source, {llvm::omp::Directive::OMPD_do}); + } + PushContextAndClauseSets(beginDir.source, beginDir.v); CheckNoBranching(block, beginDir.v, beginDir.source); } @@ -401,7 +424,6 @@ CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate) CHECK_SIMPLE_CLAUSE(Default, OMPC_default) CHECK_SIMPLE_CLAUSE(Device, OMPC_device) CHECK_SIMPLE_CLAUSE(Final, OMPC_final) -CHECK_SIMPLE_CLAUSE(Firstprivate, OMPC_firstprivate) CHECK_SIMPLE_CLAUSE(From, OMPC_from) CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr) @@ -487,6 +509,23 @@ void OmpStructureChecker::CheckIsVarPartOfAnotherVar( ompObject.u); } } +void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { + CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); + CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); +} +void OmpStructureChecker::CheckIsLoopIvPartOfClause( + llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) { + for (const auto &ompObject : ompObjectList.v) { + if (const parser::Name * name{parser::Unwrap(ompObject)}) { + if (name->symbol == GetContext().loopIV) { + context_.Say(name->source, + "DO iteration variable %s is not allowed in %s clause."_err_en_US, + name->ToString(), + parser::ToUpperCaseLetters(getClauseName(clause).str())); + } + } + } +} // Following clauses have a seperate node in parse-tree.h. // Atomic-clause CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read) diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 7a96db3ec603..b12cb09ae827 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -88,6 +88,7 @@ public: #include "llvm/Frontend/OpenMP/OMP.inc" ) { } + using llvmOmpClause = const llvm::omp::Clause; void Enter(const parser::OpenMPConstruct &); void Enter(const parser::OpenMPLoopConstruct &); @@ -207,6 +208,11 @@ private: const parser::OmpObjectList &, const llvm::omp::Clause); void GetSymbolsInObjectList( const parser::OmpObjectList &, std::vector &); + + const parser::Name GetLoopIndex(const parser::DoConstruct *x); + void SetLoopInfo(const parser::OpenMPLoopConstruct &x); + void CheckIsLoopIvPartOfClause( + llvmOmpClause clause, const parser::OmpObjectList &ompObjectList); }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ diff --git a/flang/test/Semantics/omp-do01-positivecase.f90 b/flang/test/Semantics/omp-do01-positivecase.f90 new file mode 100644 index 000000000000..291b5e2a76a7 --- /dev/null +++ b/flang/test/Semantics/omp-do01-positivecase.f90 @@ -0,0 +1,19 @@ +! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.7.1 Loop Construct +! The loop iteration variable may not appear in a firstprivate directive. +! A positive case + +!DEF: /omp_do MainProgram +program omp_do + !DEF: /omp_do/i ObjectEntity INTEGER(4) + integer i + + !$omp do firstprivate(k) + !DEF: /omp_do/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + print *, "Hello" + end do + !$omp end do + +end program omp_do diff --git a/flang/test/Semantics/omp-do01.f90 b/flang/test/Semantics/omp-do01.f90 index d87d60254fd2..7e858a5a26a9 100644 --- a/flang/test/Semantics/omp-do01.f90 +++ b/flang/test/Semantics/omp-do01.f90 @@ -1,17 +1,17 @@ ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - ! OpenMP Version 4.5 ! 2.7.1 Loop Construct -! collapse(n) where n > num of loops +! The loop iteration variable may not appear in a firstprivate directive. program omp_do integer i, j, k - !ERROR: Not enough do loops for collapsed !$OMP DO - !$omp do collapse(2) + !ERROR: DO iteration variable i is not allowed in FIRSTPRIVATE clause. + !$omp do firstprivate(k,i) do i = 1, 10 - print *, "hello" + do j = 1, 10 + print *, "Hello" + end do end do !$omp end do diff --git a/flang/test/Semantics/omp-do05-positivecase.f90 b/flang/test/Semantics/omp-do05-positivecase.f90 new file mode 100644 index 000000000000..72d68d0fb111 --- /dev/null +++ b/flang/test/Semantics/omp-do05-positivecase.f90 @@ -0,0 +1,36 @@ +! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.7.1 Loop Construct restrictions on single directive. +! A positive case + +!DEF: /omp_do MainProgram +program omp_do + !DEF: /omp_do/i ObjectEntity INTEGER(4) + !DEF: /omp_do/n ObjectEntity INTEGER(4) + integer i,n + !$omp parallel + !DEF: /omp_do/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + do i=1,10 + !$omp single + print *, "hello" + !$omp end single + end do + !$omp end parallel + + !$omp parallel default(shared) + !$omp do + !DEF: /omp_do/Block2/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4) + !REF: /omp_do/n + do i=1,n + !$omp parallel + !$omp single + !DEF: /work EXTERNAL (Subroutine) ProcEntity + !REF: /omp_do/Block2/Block1/i + call work(i, 1) + !$omp end single + !$omp end parallel + end do + !$omp end do + !$omp end parallel + +end program omp_do diff --git a/flang/test/Semantics/omp-do05.f90 b/flang/test/Semantics/omp-do05.f90 index 8722e50a64f7..fcf1911a7698 100644 --- a/flang/test/Semantics/omp-do05.f90 +++ b/flang/test/Semantics/omp-do05.f90 @@ -1,26 +1,32 @@ ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp -! XFAIL: * - ! OpenMP Version 4.5 -! 2.7.1 Loop Construct -! chunk_size must be a loop invariant integer expression -! with a positive value. +! 2.7.1 Loop Construct restrictions on single directive. + program omp_do - integer i, j, k - integer :: a(10), b(10) - a = 10 - j = 0 - !ERROR: INTEGER expression of SCHEDULE clause chunk_size must be positive - !$omp do schedule(static, -1) - do i = 1, 10 - j = j + 1 - b(i) = a(i) * 2.0 + integer n + integer i,j + !$omp do + do i=1,10 + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp single + do j=1,10 + print *,"hello" + end do + !$omp end single end do !$omp end do - print *, j - print *, b + !$omp parallel default(shared) + !$omp do + do i = 1, n + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp single + call work(i, 1) + !$omp end single + end do + !$omp end do + !$omp end parallel end program omp_do