diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 5ef504aa72326..6eec4d5d31751 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -200,6 +200,10 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) { return CheckAllowed(clause); } +bool OmpStructureChecker::IsExtendedListItem(const Symbol &sym) { + return evaluate::IsVariable(sym) || sym.IsSubprogram(); +} + bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { // Definition of close nesting: // @@ -454,6 +458,14 @@ void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) { } } +void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) { + for (const auto &[sym, source] : deferredNonVariables_) { + context_.SayWithDecl( + *sym, source, "'%s' must be a variable"_err_en_US, sym->name()); + } + deferredNonVariables_.clear(); +} + void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { const auto &beginLoopDir{std::get(x.t)}; const auto &beginDir{std::get(beginLoopDir.t)}; @@ -1246,7 +1258,8 @@ void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) { context_.Say(x.source, "If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US); } - if (toClause) { + unsigned version{context_.langOptions().OpenMPVersion}; + if (toClause && version >= 52) { context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source, "The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US); } @@ -2318,6 +2331,31 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) { void OmpStructureChecker::Enter(const parser::OmpClause &x) { SetContextClause(x); + + llvm::omp::Clause clauseId = std::visit( + [this](auto &&s) { return GetClauseKindForParserClass(s); }, x.u); + + // The visitors for these clauses do their own checks. + switch (clauseId) { + case llvm::omp::Clause::OMPC_copyprivate: + case llvm::omp::Clause::OMPC_enter: + case llvm::omp::Clause::OMPC_lastprivate: + case llvm::omp::Clause::OMPC_reduction: + case llvm::omp::Clause::OMPC_to: + return; + default: + break; + } + + if (const parser::OmpObjectList * objList{GetOmpObjectList(x)}) { + SymbolSourceMap symbols; + GetSymbolsInObjectList(*objList, symbols); + for (const auto &[sym, source] : symbols) { + if (!evaluate::IsVariable(sym)) { + deferredNonVariables_.insert({sym, source}); + } + } + } } // Following clauses do not have a separate node in parse-tree.h. @@ -2365,7 +2403,6 @@ CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd) CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes) CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction) -CHECK_SIMPLE_CLAUSE(To, OMPC_to) CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform) CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown) CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied) @@ -2391,7 +2428,6 @@ CHECK_SIMPLE_CLAUSE(CancellationConstructType, OMPC_cancellation_construct_type) CHECK_SIMPLE_CLAUSE(Doacross, OMPC_doacross) CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute) CHECK_SIMPLE_CLAUSE(OmpxBare, OMPC_ompx_bare) -CHECK_SIMPLE_CLAUSE(Enter, OMPC_enter) CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail) CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak) @@ -3357,6 +3393,47 @@ void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) { } } +void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) { + CheckAllowedClause(llvm::omp::Clause::OMPC_enter); + const parser::OmpObjectList &objList{x.v}; + SymbolSourceMap symbols; + GetSymbolsInObjectList(objList, symbols); + for (const auto &[sym, source] : symbols) { + if (!IsExtendedListItem(*sym)) { + context_.SayWithDecl(*sym, source, + "'%s' must be a variable or a procedure"_err_en_US, sym->name()); + } + } +} + +void OmpStructureChecker::Enter(const parser::OmpClause::To &x) { + CheckAllowedClause(llvm::omp::Clause::OMPC_to); + if (dirContext_.empty()) { + return; + } + // The "to" clause is only allowed on "declare target" (pre-5.1), and + // "target update". In the former case it can take an extended list item, + // in the latter a variable (a locator). + + // The "declare target" construct (and the "to" clause on it) are already + // handled (in the declare-target checkers), so just look at "to" in "target + // update". + if (GetContext().directive == llvm::omp::OMPD_declare_target) { + return; + } + assert(GetContext().directive == llvm::omp::OMPD_target_update); + + const parser::OmpObjectList &objList{x.v}; + SymbolSourceMap symbols; + GetSymbolsInObjectList(objList, symbols); + for (const auto &[sym, source] : symbols) { + if (!evaluate::IsVariable(*sym)) { + context_.SayWithDecl( + *sym, source, "'%s' must be a variable"_err_en_US, sym->name()); + } + } +} + llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) { return llvm::omp::getOpenMPClauseName(clause); } diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 605f3f05b4bc8..e6863b53ecfde 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -69,6 +69,7 @@ class OmpStructureChecker using llvmOmpClause = const llvm::omp::Clause; void Enter(const parser::OpenMPConstruct &); + void Leave(const parser::OpenMPConstruct &); void Enter(const parser::OpenMPLoopConstruct &); void Leave(const parser::OpenMPLoopConstruct &); void Enter(const parser::OmpEndLoopDirective &); @@ -140,6 +141,7 @@ class OmpStructureChecker private: bool CheckAllowedClause(llvmOmpClause clause); + bool IsExtendedListItem(const Symbol &sym); void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars, const std::list &nameList, const parser::CharBlock &item, const std::string &clauseName); @@ -246,6 +248,8 @@ class OmpStructureChecker LastType }; int directiveNest_[LastType + 1] = {0}; + + SymbolSourceMap deferredNonVariables_; }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ diff --git a/flang/test/Semantics/OpenMP/name-conflict.f90 b/flang/test/Semantics/OpenMP/name-conflict.f90 new file mode 100644 index 0000000000000..5babc3c6d3886 --- /dev/null +++ b/flang/test/Semantics/OpenMP/name-conflict.f90 @@ -0,0 +1,24 @@ +!RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp +module m + +contains + +subroutine foo1() + integer :: baz1 +!ERROR: 'baz1' must be a variable +!$omp parallel do shared(baz1) + baz1: do i = 1, 100 + enddo baz1 +!$omp end parallel do +end subroutine + +subroutine foo2() + !implicit baz2 +!ERROR: 'baz2' must be a variable +!$omp parallel do shared(baz2) + baz2: do i = 1, 100 + enddo baz2 +!$omp end parallel do +end subroutine + +end module m