[flang-commits] [flang] [flang][OpenMP] Fix scope checks for ALLOCATE directive (PR #160948)
via flang-commits
flang-commits at lists.llvm.org
Fri Sep 26 13:44:26 PDT 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Krzysztof Parzyszek (kparzysz)
<details>
<summary>Changes</summary>
Make sure that the ALLOCATE directive adds its source span to the current scope, and that the scope checks compare scoping units, not the specific scopes.
---
Full diff: https://github.com/llvm/llvm-project/pull/160948.diff
6 Files Affected:
- (modified) flang/lib/Semantics/resolve-directives.cpp (+31-33)
- (modified) flang/lib/Semantics/resolve-names.cpp (+3-1)
- (modified) flang/test/Semantics/OpenMP/allocate01.f90 (-1)
- (modified) flang/test/Semantics/OpenMP/allocate08.f90 (+3)
- (modified) flang/test/Semantics/OpenMP/allocators04.f90 (+2)
- (modified) flang/test/Semantics/OpenMP/allocators05.f90 (-2)
``````````diff
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 218e3e7266ca9..9234fa1f66387 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -362,6 +362,24 @@ 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 &) {}
@@ -952,7 +970,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
void ResolveOmpName(const parser::Name &, Symbol::Flag);
Symbol *ResolveName(const parser::Name *);
- Symbol *ResolveOmpObjectScope(const parser::Name *);
Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
void CheckMultipleAppearances(
@@ -2925,31 +2942,6 @@ Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
return nullptr;
}
-// Use this function over ResolveOmpName when an omp object's scope needs
-// resolving, it's symbol flag isn't important and a simple check for resolution
-// failure is desired. Using ResolveOmpName means needing to work with the
-// context to check for failure, whereas here a pointer comparison is all that's
-// needed.
-Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) {
-
- // TODO: Investigate whether the following block can be replaced by, or
- // included in, the ResolveOmpName function
- if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source)
- : nullptr}) {
- name->symbol = prev;
- return nullptr;
- }
-
- // TODO: Investigate whether the following block can be replaced by, or
- // included in, the ResolveOmpName function
- if (auto *ompSymbol{
- name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
- name->symbol = ompSymbol;
- return ompSymbol;
- }
- return nullptr;
-}
-
void OmpAttributeVisitor::ResolveOmpObjectList(
const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
for (const auto &ompObject : ompObjectList.v) {
@@ -3028,13 +3020,19 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
context_.Say(designator.source,
"List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement"_err_en_US);
}
- if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
- ompFlag == Symbol::Flag::OmpExecutableAllocateDirective) &&
- ResolveOmpObjectScope(name) == nullptr) {
- 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(
- llvm::omp::getOpenMPDirectiveName(directive, version)));
+ bool checkScope{ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective};
+ // In 5.1 the scope check only applies to declarative allocate.
+ if (version == 50 && !checkScope) {
+ checkScope = ompFlag == Symbol::Flag::OmpExecutableAllocateDirective;
+ }
+ if (checkScope) {
+ if (scopingUnit(GetContext().scope) !=
+ scopingUnit(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(
+ llvm::omp::getOpenMPDirectiveName(directive, version)));
+ }
}
if (ompFlag == Symbol::Flag::OmpReduction) {
// Using variables inside of a namelist in OpenMP reductions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 43b49e01c89c7..bb362602b2367 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1627,12 +1627,14 @@ class OmpVisitor : public virtual DeclarationVisitor {
void Post(const parser::OpenMPDeclareTargetConstruct &) {
SkipImplicitTyping(false);
}
- bool Pre(const parser::OpenMPDeclarativeAllocate &) {
+ bool Pre(const parser::OpenMPDeclarativeAllocate &x) {
+ AddOmpSourceRange(x.source);
SkipImplicitTyping(true);
return true;
}
void Post(const parser::OpenMPDeclarativeAllocate &) {
SkipImplicitTyping(false);
+ messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OpenMPDeclarativeConstruct &x) {
AddOmpSourceRange(x.source);
diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90
index e0b084ff0030b..5280d1b68a731 100644
--- a/flang/test/Semantics/OpenMP/allocate01.f90
+++ b/flang/test/Semantics/OpenMP/allocate01.f90
@@ -20,7 +20,6 @@ subroutine sema()
print *, a
!WARNING: OpenMP directive ALLOCATE has been deprecated, please use ALLOCATORS instead. [-Wopen-mp-usage]
- !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
!$omp allocate(x) allocator(omp_default_mem_alloc)
allocate ( x(a), darray(a, b) )
end subroutine sema
diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90
index fc950ea4fca36..5bfa918be4cad 100644
--- a/flang/test/Semantics/OpenMP/allocate08.f90
+++ b/flang/test/Semantics/OpenMP/allocate08.f90
@@ -27,10 +27,12 @@ subroutine allocate()
!$omp allocate(x) allocator(omp_default_mem_alloc)
!$omp allocate(y) allocator(omp_default_mem_alloc)
+ !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
!$omp allocate(z) allocator(omp_default_mem_alloc)
!$omp allocate(x)
!$omp allocate(y)
+ !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
!$omp allocate(z)
!$omp allocate(w) allocator(custom_allocator)
@@ -40,5 +42,6 @@ subroutine allocate()
!ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause
!$omp allocate(y) allocator(custom_allocator)
!ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause
+ !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
!$omp allocate(z) allocator(custom_allocator)
end subroutine allocate
diff --git a/flang/test/Semantics/OpenMP/allocators04.f90 b/flang/test/Semantics/OpenMP/allocators04.f90
index 212e48fbd1b26..c71c7ca8466ba 100644
--- a/flang/test/Semantics/OpenMP/allocators04.f90
+++ b/flang/test/Semantics/OpenMP/allocators04.f90
@@ -22,10 +22,12 @@ subroutine allocate()
trait(1)%value = default_mem_fb
custom_allocator = omp_init_allocator(omp_default_mem_space, 1, trait)
+ !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears
!$omp allocators allocate(omp_default_mem_alloc: a)
allocate(a)
!ERROR: If list items within the ALLOCATORS directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause
+ !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears
!$omp allocators allocate(custom_allocator: b)
allocate(b)
end subroutine
diff --git a/flang/test/Semantics/OpenMP/allocators05.f90 b/flang/test/Semantics/OpenMP/allocators05.f90
index 0e8366a2461e6..efacdfaec7647 100644
--- a/flang/test/Semantics/OpenMP/allocators05.f90
+++ b/flang/test/Semantics/OpenMP/allocators05.f90
@@ -15,11 +15,9 @@ subroutine allocate()
integer, parameter :: LEN = 2
!$omp target private(a, b)
- !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears
!$omp allocators allocate(omp_default_mem_alloc: a)
allocate(a(LEN))
!ERROR: ALLOCATORS directives that appear in a TARGET region must specify an allocator
- !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears
!$omp allocators allocate(b)
allocate(b(LEN))
!$omp end target
``````````
</details>
https://github.com/llvm/llvm-project/pull/160948
More information about the flang-commits
mailing list