diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -134,8 +134,11 @@ 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()); diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -206,6 +206,10 @@ 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); + }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -93,6 +93,24 @@ 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 &) { @@ -130,6 +148,15 @@ case llvm::omp::OMPD_parallel: CheckNoBranching(block, llvm::omp::OMPD_parallel, beginDir.source); break; + case llvm::omp::OMPD_single: + for (const auto &dirContext : dirContext_) { + if (dirContext.directive == llvm::omp::Directive::OMPD_do) { + HasInvalidWorksharingNesting( + beginDir.source, {llvm::omp::Directive::OMPD_single}); + dirContext_.pop_back(); + } + } + break; default: break; } @@ -407,7 +434,6 @@ CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate) 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) @@ -488,6 +514,31 @@ ompObject.u); } } + +void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { + CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); + for (const auto &ompObject : x.v.v) { + std::visit( + common::visitors{ + [&](const parser::Designator &designator) { + const auto *dataRef{std::get_if(&designator.u)}; + if (dataRef) { + if (const parser::Name * + name{std::get_if(&dataRef->u)}) { + if (name->symbol == GetContext().loopIV) { + context_.Say(name->source, + "DO iteration variable %s is not allowed in FIRSTPRIVATE clause."_err_en_US, + name->ToString()); + } + } + } + }, + [&](const parser::Name &name) {}, + }, + ompObject.u); + } +} + // Following clauses have a seperate node in parse-tree.h. CHECK_SIMPLE_PARSER_CLAUSE(OmpAllocateClause, OMPC_allocate) CHECK_SIMPLE_PARSER_CLAUSE(OmpDefaultClause, OMPC_default) diff --git a/flang/test/Semantics/omp-do01-postivecase.f90 b/flang/test/Semantics/omp-do01-postivecase.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-do01-postivecase.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 --- 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-postivecase.f90 b/flang/test/Semantics/omp-do05-postivecase.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-do05-postivecase.f90 @@ -0,0 +1,19 @@ +! 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) + integer i + !$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 + +end program omp_do diff --git a/flang/test/Semantics/omp-do05.f90 b/flang/test/Semantics/omp-do05.f90 --- a/flang/test/Semantics/omp-do05.f90 +++ b/flang/test/Semantics/omp-do05.f90 @@ -1,26 +1,17 @@ ! 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 + !$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 + print *,"hello" + !$omp end single end do !$omp end do - print *, j - print *, b - end program omp_do