[flang][OpenMP] Check contatining scoping unit in DECLARE_SIMD

[kparzysz]

Check if the name on DECLARE_SIMD is the name of the containing scoping unit.

Fixes #161516

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-openmp

Author: Krzysztof Parzyszek (kparzysz)

Changes

Check if the name on DECLARE_SIMD is the name of the containing scoping unit.

Fixes #161516

---

Full diff: https://github.com/llvm/llvm-project/pull/161556.diff

5 Files Affected:

• (modified) flang/include/flang/Semantics/openmp-utils.h (+2)
• (modified) flang/lib/Semantics/check-omp-structure.cpp (+11-1)
• (modified) flang/lib/Semantics/openmp-utils.cpp (+18)
• (modified) flang/lib/Semantics/resolve-directives.cpp (+2-20)
• (modified) flang/test/Semantics/OpenMP/declare-simd.f90 (+5)

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 <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.
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<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 &) {}
@@ -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

[eugeneepshteyn]

With this change the result is error not yet implemented: OpenMPDeclareSimdConstruct. Is that the intention?

[eugeneepshteyn]

The code change LGTM, as long as the resulting error is intended.

[kparzysz]

Yes. The lowering for DECLARE_SIMD isn't implemented yet.