[flang][OpenMP] Refactor/update semantic checks for ALLOCATE directive #164420
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Introduce a stack of scopes to OmpStructureChecker for scoping units, plus function/subroutine entries in interfaces. This will help with applying and locating properties introduced by declarative or informational directives (e.g. DECLARE_TARGET, REQUIRES), which are stored as flags on the corresponding symbols.
OpenMP 5.0 and 5.1 allowed the ALLOCATE directive to appear in two forms, declarative and executable. The syntax of an individual directive was the same in both cases, but the semantic restrictions were slightly different. - Update the semantic checks to reflect the different restrictions, gather them in a single function. - Improve test for the presence of a TARGET region, add a check for REQUIRES directive. - Update tests.
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics Author: Krzysztof Parzyszek (kparzysz) ChangesOpenMP 5.0 and 5.1 allowed the ALLOCATE directive to appear in two forms, declarative and executable. The syntax of an individual directive was the same in both cases, but the semantic restrictions were slightly different.
Patch is 24.29 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/164420.diff 13 Files Affected:
diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 0f851830edd46..7539d12264435 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -13,9 +13,11 @@
#ifndef FORTRAN_SEMANTICS_OPENMP_UTILS_H
#define FORTRAN_SEMANTICS_OPENMP_UTILS_H
+#include "flang/Common/indirection.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/char-block.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include "flang/Semantics/tools.h"
#include "llvm/ADT/ArrayRef.h"
@@ -74,7 +76,11 @@ bool IsVarOrFunctionRef(const MaybeExpr &expr);
bool IsMapEnteringType(parser::OmpMapType::Value type);
bool IsMapExitingType(parser::OmpMapType::Value type);
-std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr);
+MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr);
+template <typename T> MaybeExpr GetEvaluateExpr(const T &inp) {
+ return GetEvaluateExpr(parser::UnwrapRef<parser::Expr>(inp));
+}
+
std::optional<evaluate::DynamicType> GetDynamicType(
const parser::Expr &parserExpr);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index b3c4d24ad496d..2253a44ef1189 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -480,6 +480,36 @@ bool OmpStructureChecker::IsNestedInDirective(llvm::omp::Directive directive) {
return false;
}
+bool OmpStructureChecker::InTargetRegion() {
+ if (IsNestedInDirective(llvm::omp::Directive::OMPD_target)) {
+ // Return true even for device_type(host).
+ return true;
+ }
+ for (const Scope *scope : llvm::reverse(scopeStack_)) {
+ if (const auto *symbol{scope->symbol()}) {
+ if (symbol->test(Symbol::Flag::OmpDeclareTarget)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+bool OmpStructureChecker::HasRequires(llvm::omp::Clause req) {
+ const Scope &unit{GetProgramUnit(*scopeStack_.back())};
+ return common::visit(
+ [&](const auto &details) {
+ if constexpr (std::is_convertible_v<decltype(details),
+ const WithOmpDeclarative &>) {
+ if (auto *reqs{details.ompRequires()}) {
+ return reqs->test(req);
+ }
+ }
+ return false;
+ },
+ DEREF(unit.symbol()).details());
+}
+
void OmpStructureChecker::CheckVariableListItem(
const SymbolSourceMap &symbols) {
for (auto &[symbol, source] : symbols) {
@@ -1680,40 +1710,92 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
dirContext_.pop_back();
}
-void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
- isPredefinedAllocator = true;
- const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
- SymbolSourceMap currSymbols;
- GetSymbolsInObjectList(objectList, currSymbols);
- for (auto &[symbol, source] : currSymbols) {
- if (IsPointer(*symbol)) {
+void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
+ const parser::OmpObjectList &objects,
+ const parser::OmpClauseList &clauses) {
+ const Scope &thisScope{context_.FindScope(source)};
+ SymbolSourceMap symbols;
+ GetSymbolsInObjectList(objects, symbols);
+
+ auto hasPredefinedAllocator{[&](const parser::OmpClause *c) {
+ if (!c) {
+ return std::make_optional(false);
+ }
+ auto *allocator{std::get_if<parser::OmpClause::Allocator>(&c->u)};
+ if (auto val{ToInt64(GetEvaluateExpr(allocator->v))}) {
+ // Predefined allocators:
+ // omp_null_allocator = 0,
+ // omp_default_mem_alloc = 1,
+ // omp_large_cap_mem_alloc = 2,
+ // omp_const_mem_alloc = 3,
+ // omp_high_bw_mem_alloc = 4,
+ // omp_low_lat_mem_alloc = 5,
+ // omp_cgroup_mem_alloc = 6,
+ // omp_pteam_mem_alloc = 7,
+ // omp_thread_mem_alloc = 8
+ return std::make_optional(*val >= 0 && *val <= 8);
+ }
+ return std::optional<bool>{};
+ }};
+
+ const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)};
+ if (InTargetRegion()) {
+ bool hasDynAllocators{
+ HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};
+ if (!allocator && !hasDynAllocators) {
context_.Say(source,
- "List item '%s' in ALLOCATE directive must not have POINTER "
- "attribute"_err_en_US,
- source.ToString());
+ "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);
}
- if (IsDummy(*symbol)) {
- context_.Say(source,
- "List item '%s' in ALLOCATE directive must not be a dummy "
- "argument"_err_en_US,
- source.ToString());
+ }
+
+ bool isPredefined{hasPredefinedAllocator(allocator).value_or(false)};
+
+ for (auto &[symbol, source] : symbols) {
+ if (!inExecutableAllocate_) {
+ if (symbol->owner() != thisScope) {
+ context_.Say(source,
+ "A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears"_err_en_US);
+ }
+ if (IsPointer(*symbol) || IsAllocatable(*symbol)) {
+ context_.Say(source,
+ "A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute"_err_en_US);
+ }
}
if (symbol->GetUltimate().has<AssocEntityDetails>()) {
context_.Say(source,
- "List item '%s' in ALLOCATE directive must not be an associate "
- "name"_err_en_US,
- source.ToString());
+ "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US);
+ }
+ if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) {
+ if (!allocator) {
+ context_.Say(source,
+ "If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US);
+ } else if (!isPredefined) {
+ context_.Say(source,
+ "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_warn_en_US);
+ }
+ }
+ if (FindCommonBlockContaining(*symbol)) {
+ context_.Say(source,
+ "A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block"_err_en_US);
}
}
- CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
+ CheckVarIsNotPartOfAnotherVar(source, objects);
}
-void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
- CheckPredefinedAllocatorRestriction(dir.source, objectList);
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+ if (!inExecutableAllocate_) {
+ const auto &dir{std::get<parser::Verbatim>(x.t)};
+ const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
+ const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
+
+ isPredefinedAllocator = true;
+ CheckAllocateDirective(dir.source, objectList, clauseList);
+ }
dirContext_.pop_back();
}
@@ -2069,6 +2151,7 @@ void OmpStructureChecker::CheckNameInAllocateStmt(
}
void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
+ inExecutableAllocate_ = true;
const auto &dir{std::get<parser::Verbatim>(x.t)};
PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
@@ -2078,24 +2161,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
"The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US);
}
- bool hasAllocator = false;
- // TODO: Investigate whether searching the clause list can be done with
- // parser::Unwrap instead of the following loop
- const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
- for (const auto &clause : clauseList.v) {
- if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) {
- hasAllocator = true;
- }
- }
-
- if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) {
- // TODO: expand this check to exclude the case when a requires
- // directive with the dynamic_allocators clause is present
- // in the same compilation unit (OMP5.0 2.11.3).
- context_.Say(x.source,
- "ALLOCATE directives that appear in a TARGET region must specify an allocator clause"_err_en_US);
- }
-
const auto &allocateStmt =
std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement;
if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
@@ -2112,18 +2177,34 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
}
isPredefinedAllocator = true;
- const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
- if (objectList) {
- CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
- }
}
void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
- const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
- if (objectList)
- CheckPredefinedAllocatorRestriction(dir.source, *objectList);
+ parser::OmpObjectList empty{std::list<parser::OmpObject>{}};
+ auto &objects{[&]() -> const parser::OmpObjectList & {
+ if (auto &objects{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
+ return *objects;
+ } else {
+ return empty;
+ }
+ }()};
+ auto &clauses{std::get<parser::OmpClauseList>(x.t)};
+ CheckAllocateDirective(
+ std::get<parser::Verbatim>(x.t).source, objects, clauses);
+
+ if (const auto &subDirs{
+ std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+ x.t)}) {
+ for (const auto &dalloc : *subDirs) {
+ const auto &dir{std::get<parser::Verbatim>(x.t)};
+ const auto &clauses{std::get<parser::OmpClauseList>(dalloc.t)};
+ const auto &objects{std::get<parser::OmpObjectList>(dalloc.t)};
+ CheckAllocateDirective(dir.source, objects, clauses);
+ }
+ }
+
dirContext_.pop_back();
+ inExecutableAllocate_ = false;
}
void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index a09d8bad6b4cd..70d1ad3f44514 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -189,10 +189,12 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
const parser::CharBlock &, const OmpDirectiveSet &);
bool IsCloselyNestedRegion(const OmpDirectiveSet &set);
bool IsNestedInDirective(llvm::omp::Directive directive);
+ bool InTargetRegion();
void HasInvalidTeamsNesting(
const llvm::omp::Directive &dir, const parser::CharBlock &source);
void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x);
void HasInvalidLoopBinding(const parser::OpenMPLoopConstruct &x);
+ bool HasRequires(llvm::omp::Clause req);
// specific clause related
void CheckAllowedMapTypes(
parser::OmpMapType::Value, llvm::ArrayRef<parser::OmpMapType::Value>);
@@ -262,6 +264,9 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
bool CheckTargetBlockOnlyTeams(const parser::Block &);
void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
void CheckWorkdistributeBlockStmts(const parser::Block &, parser::CharBlock);
+ void CheckAllocateDirective(parser::CharBlock source,
+ const parser::OmpObjectList &objects,
+ const parser::OmpClauseList &clauses);
void CheckIteratorRange(const parser::OmpIteratorSpecifier &x);
void CheckIteratorModifier(const parser::OmpIterator &x);
@@ -379,6 +384,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
};
int directiveNest_[LastType + 1] = {0};
+ bool inExecutableAllocate_{false};
parser::CharBlock visitedAtomicSource_;
SymbolSourceMap deferredNonVariables_;
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 292e73b4899c0..cc55bb4954cc3 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -218,7 +218,7 @@ bool IsMapExitingType(parser::OmpMapType::Value type) {
}
}
-std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
+MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr) {
const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
// ForwardOwningPointer typedExpr
// `- GenericExprWrapper ^.get()
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 33e9ea5a89efd..cbbc8106115c8 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3107,26 +3107,6 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
AddAllocateName(name);
}
}
- if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
- IsAllocatable(*symbol) &&
- !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) {
- 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);
- }
- 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 (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(
- llvm::omp::getOpenMPDirectiveName(directive, version)));
- }
- }
if (ompFlag == Symbol::Flag::OmpReduction) {
// Using variables inside of a namelist in OpenMP reductions
// is allowed by the standard, but is not allowed for
diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90
index 1d99811156438..229fd4d6c3f95 100644
--- a/flang/test/Semantics/OpenMP/allocate01.f90
+++ b/flang/test/Semantics/OpenMP/allocate01.f90
@@ -15,7 +15,7 @@ subroutine sema()
integer :: a, b
real, dimension (:,:), allocatable :: darray
- !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
!$omp allocate(y)
print *, a
diff --git a/flang/test/Semantics/OpenMP/allocate04.f90 b/flang/test/Semantics/OpenMP/allocate04.f90
index bbd74eb2ca101..5fd75bad6c4ec 100644
--- a/flang/test/Semantics/OpenMP/allocate04.f90
+++ b/flang/test/Semantics/OpenMP/allocate04.f90
@@ -14,16 +14,19 @@ subroutine allocate(z)
type(c_ptr), pointer :: p
integer :: x, y, z
- associate (a => x)
- !$omp allocate(x) allocator(omp_default_mem_alloc)
-
!ERROR: PRIVATE clause is not allowed on the ALLOCATE directive
!$omp allocate(y) private(y)
- !ERROR: List item 'z' in ALLOCATE directive must not be a dummy argument
- !$omp allocate(z)
- !ERROR: List item 'p' in ALLOCATE directive must not have POINTER attribute
+ !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute
!$omp allocate(p)
- !ERROR: List item 'a' in ALLOCATE directive must not be an associate name
+
+ associate (a => x)
+ block
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
+ !$omp allocate(x) allocator(omp_default_mem_alloc)
+
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
+ !ERROR: A list item in a declarative ALLOCATE cannot be an associate name
!$omp allocate(a)
+ end block
end associate
end subroutine allocate
diff --git a/flang/test/Semantics/OpenMP/allocate05.f90 b/flang/test/Semantics/OpenMP/allocate05.f90
index a787e8bb32a4c..b5f7864a42b92 100644
--- a/flang/test/Semantics/OpenMP/allocate05.f90
+++ b/flang/test/Semantics/OpenMP/allocate05.f90
@@ -18,7 +18,7 @@ subroutine allocate()
!$omp end target
!$omp target
- !ERROR: ALLOCATE directives that appear in a TARGET region must specify an allocator clause
+ !ERROR: An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified
!$omp allocate
allocate ( darray(a, b) )
!$omp end target
diff --git a/flang/test/Semantics/OpenMP/allocate06.f90 b/flang/test/Semantics/OpenMP/allocate06.f90
index e14134cd07301..9b57322bbadc6 100644
--- a/flang/test/Semantics/OpenMP/allocate06.f90
+++ b/flang/test/Semantics/OpenMP/allocate06.f90
@@ -11,7 +11,7 @@ subroutine allocate()
integer :: a, b, x
real, dimension (:,:), allocatable :: darray
- !ERROR: List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement
+ !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute
!$omp allocate(darray) allocator(omp_default_mem_alloc)
!$omp allocate(darray) allocator(omp_default_mem_alloc)
diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90
index 5bfa918be4cad..e12eb4a7b7526 100644
--- a/flang/test/Semantics/OpenMP/allocate08.f90
+++ b/flang/test/Semantics/OpenMP/allocate08.f90
@@ -3,14 +3,15 @@
! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags
! OpenMP Version 5.0
! 2.11.3 allocate Directive
-! 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
+! 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
module AllocateModule
INTEGER :: z
end module
-subroutine allocate()
+subroutine allocate(custom_allocator)
use omp_lib
use AllocateModule
integer, SAVE :: x
@@ -18,30 +19,26 @@ subroutine allocate()
COMMON /CommonName/ y
integer(kind=omp_allocator_handle_kind) :: custom_allocator
- integer(kind=omp_memspace_handle_kind) :: memspace
- type(omp_alloctrait), dimension(1) :: trait
- memspace = omp_default_mem_space
- trait(1)%key = fallback
- trait(1)%value = default_mem_fb
- custom_allocator = omp_init_allocator(memspace, 1, trait)
!$omp allocate(x) allocator(omp_default_mem_alloc)
+ !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block
!$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
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
!$omp allocate(z) allocator(omp_default_mem_alloc)
+ !ERROR: If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator
!$omp allocate(x)
+ !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block
!$omp allocate(y)
- !ERROR: List items must be declared in ...
[truncated]
|
|
@llvm/pr-subscribers-flang-openmp Author: Krzysztof Parzyszek (kparzysz) ChangesOpenMP 5.0 and 5.1 allowed the ALLOCATE directive to appear in two forms, declarative and executable. The syntax of an individual directive was the same in both cases, but the semantic restrictions were slightly different.
Patch is 24.29 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/164420.diff 13 Files Affected:
diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 0f851830edd46..7539d12264435 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -13,9 +13,11 @@
#ifndef FORTRAN_SEMANTICS_OPENMP_UTILS_H
#define FORTRAN_SEMANTICS_OPENMP_UTILS_H
+#include "flang/Common/indirection.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/char-block.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include "flang/Semantics/tools.h"
#include "llvm/ADT/ArrayRef.h"
@@ -74,7 +76,11 @@ bool IsVarOrFunctionRef(const MaybeExpr &expr);
bool IsMapEnteringType(parser::OmpMapType::Value type);
bool IsMapExitingType(parser::OmpMapType::Value type);
-std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr);
+MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr);
+template <typename T> MaybeExpr GetEvaluateExpr(const T &inp) {
+ return GetEvaluateExpr(parser::UnwrapRef<parser::Expr>(inp));
+}
+
std::optional<evaluate::DynamicType> GetDynamicType(
const parser::Expr &parserExpr);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index b3c4d24ad496d..2253a44ef1189 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -480,6 +480,36 @@ bool OmpStructureChecker::IsNestedInDirective(llvm::omp::Directive directive) {
return false;
}
+bool OmpStructureChecker::InTargetRegion() {
+ if (IsNestedInDirective(llvm::omp::Directive::OMPD_target)) {
+ // Return true even for device_type(host).
+ return true;
+ }
+ for (const Scope *scope : llvm::reverse(scopeStack_)) {
+ if (const auto *symbol{scope->symbol()}) {
+ if (symbol->test(Symbol::Flag::OmpDeclareTarget)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+bool OmpStructureChecker::HasRequires(llvm::omp::Clause req) {
+ const Scope &unit{GetProgramUnit(*scopeStack_.back())};
+ return common::visit(
+ [&](const auto &details) {
+ if constexpr (std::is_convertible_v<decltype(details),
+ const WithOmpDeclarative &>) {
+ if (auto *reqs{details.ompRequires()}) {
+ return reqs->test(req);
+ }
+ }
+ return false;
+ },
+ DEREF(unit.symbol()).details());
+}
+
void OmpStructureChecker::CheckVariableListItem(
const SymbolSourceMap &symbols) {
for (auto &[symbol, source] : symbols) {
@@ -1680,40 +1710,92 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
dirContext_.pop_back();
}
-void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
- isPredefinedAllocator = true;
- const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
- PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
- SymbolSourceMap currSymbols;
- GetSymbolsInObjectList(objectList, currSymbols);
- for (auto &[symbol, source] : currSymbols) {
- if (IsPointer(*symbol)) {
+void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
+ const parser::OmpObjectList &objects,
+ const parser::OmpClauseList &clauses) {
+ const Scope &thisScope{context_.FindScope(source)};
+ SymbolSourceMap symbols;
+ GetSymbolsInObjectList(objects, symbols);
+
+ auto hasPredefinedAllocator{[&](const parser::OmpClause *c) {
+ if (!c) {
+ return std::make_optional(false);
+ }
+ auto *allocator{std::get_if<parser::OmpClause::Allocator>(&c->u)};
+ if (auto val{ToInt64(GetEvaluateExpr(allocator->v))}) {
+ // Predefined allocators:
+ // omp_null_allocator = 0,
+ // omp_default_mem_alloc = 1,
+ // omp_large_cap_mem_alloc = 2,
+ // omp_const_mem_alloc = 3,
+ // omp_high_bw_mem_alloc = 4,
+ // omp_low_lat_mem_alloc = 5,
+ // omp_cgroup_mem_alloc = 6,
+ // omp_pteam_mem_alloc = 7,
+ // omp_thread_mem_alloc = 8
+ return std::make_optional(*val >= 0 && *val <= 8);
+ }
+ return std::optional<bool>{};
+ }};
+
+ const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)};
+ if (InTargetRegion()) {
+ bool hasDynAllocators{
+ HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};
+ if (!allocator && !hasDynAllocators) {
context_.Say(source,
- "List item '%s' in ALLOCATE directive must not have POINTER "
- "attribute"_err_en_US,
- source.ToString());
+ "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);
}
- if (IsDummy(*symbol)) {
- context_.Say(source,
- "List item '%s' in ALLOCATE directive must not be a dummy "
- "argument"_err_en_US,
- source.ToString());
+ }
+
+ bool isPredefined{hasPredefinedAllocator(allocator).value_or(false)};
+
+ for (auto &[symbol, source] : symbols) {
+ if (!inExecutableAllocate_) {
+ if (symbol->owner() != thisScope) {
+ context_.Say(source,
+ "A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears"_err_en_US);
+ }
+ if (IsPointer(*symbol) || IsAllocatable(*symbol)) {
+ context_.Say(source,
+ "A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute"_err_en_US);
+ }
}
if (symbol->GetUltimate().has<AssocEntityDetails>()) {
context_.Say(source,
- "List item '%s' in ALLOCATE directive must not be an associate "
- "name"_err_en_US,
- source.ToString());
+ "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US);
+ }
+ if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) {
+ if (!allocator) {
+ context_.Say(source,
+ "If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US);
+ } else if (!isPredefined) {
+ context_.Say(source,
+ "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_warn_en_US);
+ }
+ }
+ if (FindCommonBlockContaining(*symbol)) {
+ context_.Say(source,
+ "A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block"_err_en_US);
}
}
- CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
+ CheckVarIsNotPartOfAnotherVar(source, objects);
}
-void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
- CheckPredefinedAllocatorRestriction(dir.source, objectList);
+ PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+ if (!inExecutableAllocate_) {
+ const auto &dir{std::get<parser::Verbatim>(x.t)};
+ const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
+ const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
+
+ isPredefinedAllocator = true;
+ CheckAllocateDirective(dir.source, objectList, clauseList);
+ }
dirContext_.pop_back();
}
@@ -2069,6 +2151,7 @@ void OmpStructureChecker::CheckNameInAllocateStmt(
}
void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
+ inExecutableAllocate_ = true;
const auto &dir{std::get<parser::Verbatim>(x.t)};
PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
@@ -2078,24 +2161,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
"The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US);
}
- bool hasAllocator = false;
- // TODO: Investigate whether searching the clause list can be done with
- // parser::Unwrap instead of the following loop
- const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
- for (const auto &clause : clauseList.v) {
- if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) {
- hasAllocator = true;
- }
- }
-
- if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) {
- // TODO: expand this check to exclude the case when a requires
- // directive with the dynamic_allocators clause is present
- // in the same compilation unit (OMP5.0 2.11.3).
- context_.Say(x.source,
- "ALLOCATE directives that appear in a TARGET region must specify an allocator clause"_err_en_US);
- }
-
const auto &allocateStmt =
std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement;
if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
@@ -2112,18 +2177,34 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
}
isPredefinedAllocator = true;
- const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
- if (objectList) {
- CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
- }
}
void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
- const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
- if (objectList)
- CheckPredefinedAllocatorRestriction(dir.source, *objectList);
+ parser::OmpObjectList empty{std::list<parser::OmpObject>{}};
+ auto &objects{[&]() -> const parser::OmpObjectList & {
+ if (auto &objects{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
+ return *objects;
+ } else {
+ return empty;
+ }
+ }()};
+ auto &clauses{std::get<parser::OmpClauseList>(x.t)};
+ CheckAllocateDirective(
+ std::get<parser::Verbatim>(x.t).source, objects, clauses);
+
+ if (const auto &subDirs{
+ std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+ x.t)}) {
+ for (const auto &dalloc : *subDirs) {
+ const auto &dir{std::get<parser::Verbatim>(x.t)};
+ const auto &clauses{std::get<parser::OmpClauseList>(dalloc.t)};
+ const auto &objects{std::get<parser::OmpObjectList>(dalloc.t)};
+ CheckAllocateDirective(dir.source, objects, clauses);
+ }
+ }
+
dirContext_.pop_back();
+ inExecutableAllocate_ = false;
}
void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index a09d8bad6b4cd..70d1ad3f44514 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -189,10 +189,12 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
const parser::CharBlock &, const OmpDirectiveSet &);
bool IsCloselyNestedRegion(const OmpDirectiveSet &set);
bool IsNestedInDirective(llvm::omp::Directive directive);
+ bool InTargetRegion();
void HasInvalidTeamsNesting(
const llvm::omp::Directive &dir, const parser::CharBlock &source);
void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x);
void HasInvalidLoopBinding(const parser::OpenMPLoopConstruct &x);
+ bool HasRequires(llvm::omp::Clause req);
// specific clause related
void CheckAllowedMapTypes(
parser::OmpMapType::Value, llvm::ArrayRef<parser::OmpMapType::Value>);
@@ -262,6 +264,9 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
bool CheckTargetBlockOnlyTeams(const parser::Block &);
void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
void CheckWorkdistributeBlockStmts(const parser::Block &, parser::CharBlock);
+ void CheckAllocateDirective(parser::CharBlock source,
+ const parser::OmpObjectList &objects,
+ const parser::OmpClauseList &clauses);
void CheckIteratorRange(const parser::OmpIteratorSpecifier &x);
void CheckIteratorModifier(const parser::OmpIterator &x);
@@ -379,6 +384,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
};
int directiveNest_[LastType + 1] = {0};
+ bool inExecutableAllocate_{false};
parser::CharBlock visitedAtomicSource_;
SymbolSourceMap deferredNonVariables_;
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 292e73b4899c0..cc55bb4954cc3 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -218,7 +218,7 @@ bool IsMapExitingType(parser::OmpMapType::Value type) {
}
}
-std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
+MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr) {
const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
// ForwardOwningPointer typedExpr
// `- GenericExprWrapper ^.get()
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 33e9ea5a89efd..cbbc8106115c8 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -3107,26 +3107,6 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
AddAllocateName(name);
}
}
- if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
- IsAllocatable(*symbol) &&
- !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) {
- 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);
- }
- 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 (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(
- llvm::omp::getOpenMPDirectiveName(directive, version)));
- }
- }
if (ompFlag == Symbol::Flag::OmpReduction) {
// Using variables inside of a namelist in OpenMP reductions
// is allowed by the standard, but is not allowed for
diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90
index 1d99811156438..229fd4d6c3f95 100644
--- a/flang/test/Semantics/OpenMP/allocate01.f90
+++ b/flang/test/Semantics/OpenMP/allocate01.f90
@@ -15,7 +15,7 @@ subroutine sema()
integer :: a, b
real, dimension (:,:), allocatable :: darray
- !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
!$omp allocate(y)
print *, a
diff --git a/flang/test/Semantics/OpenMP/allocate04.f90 b/flang/test/Semantics/OpenMP/allocate04.f90
index bbd74eb2ca101..5fd75bad6c4ec 100644
--- a/flang/test/Semantics/OpenMP/allocate04.f90
+++ b/flang/test/Semantics/OpenMP/allocate04.f90
@@ -14,16 +14,19 @@ subroutine allocate(z)
type(c_ptr), pointer :: p
integer :: x, y, z
- associate (a => x)
- !$omp allocate(x) allocator(omp_default_mem_alloc)
-
!ERROR: PRIVATE clause is not allowed on the ALLOCATE directive
!$omp allocate(y) private(y)
- !ERROR: List item 'z' in ALLOCATE directive must not be a dummy argument
- !$omp allocate(z)
- !ERROR: List item 'p' in ALLOCATE directive must not have POINTER attribute
+ !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute
!$omp allocate(p)
- !ERROR: List item 'a' in ALLOCATE directive must not be an associate name
+
+ associate (a => x)
+ block
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
+ !$omp allocate(x) allocator(omp_default_mem_alloc)
+
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
+ !ERROR: A list item in a declarative ALLOCATE cannot be an associate name
!$omp allocate(a)
+ end block
end associate
end subroutine allocate
diff --git a/flang/test/Semantics/OpenMP/allocate05.f90 b/flang/test/Semantics/OpenMP/allocate05.f90
index a787e8bb32a4c..b5f7864a42b92 100644
--- a/flang/test/Semantics/OpenMP/allocate05.f90
+++ b/flang/test/Semantics/OpenMP/allocate05.f90
@@ -18,7 +18,7 @@ subroutine allocate()
!$omp end target
!$omp target
- !ERROR: ALLOCATE directives that appear in a TARGET region must specify an allocator clause
+ !ERROR: An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified
!$omp allocate
allocate ( darray(a, b) )
!$omp end target
diff --git a/flang/test/Semantics/OpenMP/allocate06.f90 b/flang/test/Semantics/OpenMP/allocate06.f90
index e14134cd07301..9b57322bbadc6 100644
--- a/flang/test/Semantics/OpenMP/allocate06.f90
+++ b/flang/test/Semantics/OpenMP/allocate06.f90
@@ -11,7 +11,7 @@ subroutine allocate()
integer :: a, b, x
real, dimension (:,:), allocatable :: darray
- !ERROR: List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement
+ !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute
!$omp allocate(darray) allocator(omp_default_mem_alloc)
!$omp allocate(darray) allocator(omp_default_mem_alloc)
diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90
index 5bfa918be4cad..e12eb4a7b7526 100644
--- a/flang/test/Semantics/OpenMP/allocate08.f90
+++ b/flang/test/Semantics/OpenMP/allocate08.f90
@@ -3,14 +3,15 @@
! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags
! OpenMP Version 5.0
! 2.11.3 allocate Directive
-! 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
+! 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
module AllocateModule
INTEGER :: z
end module
-subroutine allocate()
+subroutine allocate(custom_allocator)
use omp_lib
use AllocateModule
integer, SAVE :: x
@@ -18,30 +19,26 @@ subroutine allocate()
COMMON /CommonName/ y
integer(kind=omp_allocator_handle_kind) :: custom_allocator
- integer(kind=omp_memspace_handle_kind) :: memspace
- type(omp_alloctrait), dimension(1) :: trait
- memspace = omp_default_mem_space
- trait(1)%key = fallback
- trait(1)%value = default_mem_fb
- custom_allocator = omp_init_allocator(memspace, 1, trait)
!$omp allocate(x) allocator(omp_default_mem_alloc)
+ !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block
!$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
+ !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears
!$omp allocate(z) allocator(omp_default_mem_alloc)
+ !ERROR: If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator
!$omp allocate(x)
+ !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block
!$omp allocate(y)
- !ERROR: List items must be declared in ...
[truncated]
|
ergawy
approved these changes
Oct 22, 2025
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
4 participants
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
OpenMP 5.0 and 5.1 allowed the ALLOCATE directive to appear in two forms, declarative and executable. The syntax of an individual directive was the same in both cases, but the semantic restrictions were slightly different.