Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions flang/include/flang/Semantics/openmp-utils.h
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,8 @@ template <typename T, typename U = std::remove_const_t<T>> U AsRvalue(T &t) {

template <typename T> 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<T>. This structure keeps the ActionStmt with the
// extracted source for further use.
Expand Down
12 changes: 11 additions & 1 deletion flang/lib/Semantics/check-omp-structure.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand Down
18 changes: 18 additions & 0 deletions flang/lib/Semantics/openmp-utils.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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{};
Expand Down
22 changes: 2 additions & 20 deletions flang/lib/Semantics/resolve-directives.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -379,24 +379,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
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 <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
template <typename A> bool Pre(const A &) { return true; }
template <typename A> void Post(const A &) {}
Expand Down Expand Up @@ -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(
Expand Down
5 changes: 5 additions & 0 deletions flang/test/Semantics/OpenMP/declare-simd.f90
Original file line number Diff line number Diff line change
Expand Up @@ -19,4 +19,9 @@ subroutine f00
subroutine f01
end

integer function f02
!Ok, expect no diagnostics
!$omp declare_simd(f02)
end

end module