diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h index 08b67167f5de2..2954a1c4769f7 100644 --- a/flang/include/flang/Semantics/openmp-utils.h +++ b/flang/include/flang/Semantics/openmp-utils.h @@ -37,6 +37,8 @@ template > U AsRvalue(T &t) { template T &&AsRvalue(T &&t) { return std::move(t); } +const Scope &GetScopingUnit(const Scope &scope); + // There is no consistent way to get the source of an ActionStmt, but there // is "source" in Statement. This structure keeps the ActionStmt with the // extracted source for further use. diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index e224e069abcef..1f059f747bad0 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1361,9 +1361,19 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) { return; } + auto isValidSymbol{[](const Symbol *sym) { + if (IsProcedure(*sym) || IsFunction(*sym)) { + return true; + } + if (const Symbol *owner{GetScopingUnit(sym->owner()).symbol()}) { + return IsProcedure(*owner) || IsFunction(*owner); + } + return false; + }}; + const parser::OmpArgument &arg{args.v.front()}; if (auto *sym{GetArgumentSymbol(arg)}) { - if (!IsProcedure(*sym) && !IsFunction(*sym)) { + if (!isValidSymbol(sym)) { auto &msg{context_.Say(arg.source, "The name '%s' should refer to a procedure"_err_en_US, sym->name())}; if (sym->test(Symbol::Flag::Implicit)) { diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 35b7718715071..a8ec4d6c24beb 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -41,6 +41,24 @@ namespace Fortran::semantics::omp { using namespace Fortran::parser::omp; +const Scope &GetScopingUnit(const Scope &scope) { + const Scope *iter{&scope}; + for (; !iter->IsTopLevel(); iter = &iter->parent()) { + switch (iter->kind()) { + case Scope::Kind::BlockConstruct: + case Scope::Kind::BlockData: + case Scope::Kind::DerivedType: + case Scope::Kind::MainProgram: + case Scope::Kind::Module: + case Scope::Kind::Subprogram: + return *iter; + default: + break; + } + } + return *iter; +} + SourcedActionStmt GetActionStmt(const parser::ExecutionPartConstruct *x) { if (x == nullptr) { return SourcedActionStmt{}; diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index bd7b8ac552fab..25872be4af52e 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -379,24 +379,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { explicit OmpAttributeVisitor(SemanticsContext &context) : DirectiveAttributeVisitor(context) {} - static const Scope &scopingUnit(const Scope &scope) { - const Scope *iter{&scope}; - for (; !iter->IsTopLevel(); iter = &iter->parent()) { - switch (iter->kind()) { - case Scope::Kind::BlockConstruct: - case Scope::Kind::BlockData: - case Scope::Kind::DerivedType: - case Scope::Kind::MainProgram: - case Scope::Kind::Module: - case Scope::Kind::Subprogram: - return *iter; - default: - break; - } - } - return *iter; - } - template void Walk(const A &x) { parser::Walk(x, *this); } template bool Pre(const A &) { return true; } template void Post(const A &) {} @@ -3086,8 +3068,8 @@ void OmpAttributeVisitor::ResolveOmpDesignator( checkScope = ompFlag == Symbol::Flag::OmpExecutableAllocateDirective; } if (checkScope) { - if (scopingUnit(GetContext().scope) != - scopingUnit(symbol->GetUltimate().owner())) { + if (omp::GetScopingUnit(GetContext().scope) != + omp::GetScopingUnit(symbol->GetUltimate().owner())) { context_.Say(designator.source, // 2.15.3 "List items must be declared in the same scoping unit in which the %s directive appears"_err_en_US, parser::ToUpperCaseLetters( diff --git a/flang/test/Semantics/OpenMP/declare-simd.f90 b/flang/test/Semantics/OpenMP/declare-simd.f90 index ceed2c262555a..bb259b8722ca2 100644 --- a/flang/test/Semantics/OpenMP/declare-simd.f90 +++ b/flang/test/Semantics/OpenMP/declare-simd.f90 @@ -19,4 +19,9 @@ subroutine f00 subroutine f01 end +integer function f02 +!Ok, expect no diagnostics +!$omp declare_simd(f02) +end + end module