From 3829611d514c402553fe8d822f7378dca35dec82 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Wed, 29 Oct 2025 13:16:24 -0500 Subject: [PATCH 1/7] [flang][OpenMP] Reorganize ALLOCATE-related semantic checks For ALLOCATORS and executable ALLOCATE first perform list item checks in the context of an individual ALLOCATE clause or directive respectively, then perform "global" checks, e.g. whether all list items are present on the ALLOCATE statement. These changes allowed to simplify the checks for presence on ALLOCATE statement and the use of a predefined allocator. Additionally, allow variable list item lists to be empty, add a test for the related spec restriction. This is a first step towards unifying OpenMPDeclarativeAllocate and OpenMPExecutableAllocate into a single directive. --- flang/include/flang/Parser/parse-tree.h | 2 +- flang/include/flang/Semantics/openmp-utils.h | 2 + flang/lib/Parser/openmp-parsers.cpp | 14 +- flang/lib/Parser/unparse.cpp | 2 +- flang/lib/Semantics/check-omp-structure.cpp | 435 ++++++++++--------- flang/lib/Semantics/check-omp-structure.h | 10 - flang/lib/Semantics/openmp-utils.cpp | 17 + flang/lib/Semantics/resolve-directives.cpp | 5 +- flang/test/Semantics/OpenMP/allocate08.f90 | 8 +- flang/test/Semantics/OpenMP/allocate09.f90 | 4 +- flang/test/Semantics/OpenMP/allocate10.f90 | 11 + flang/test/Semantics/OpenMP/allocate11.f90 | 27 ++ flang/test/Semantics/OpenMP/allocators01.f90 | 2 +- flang/test/Semantics/OpenMP/allocators04.f90 | 31 -- flang/test/Semantics/OpenMP/allocators05.f90 | 2 +- flang/test/Semantics/OpenMP/allocators07.f90 | 6 +- 16 files changed, 322 insertions(+), 256 deletions(-) create mode 100644 flang/test/Semantics/OpenMP/allocate10.f90 create mode 100644 flang/test/Semantics/OpenMP/allocate11.f90 delete mode 100644 flang/test/Semantics/OpenMP/allocators04.f90 diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 375790af90b74..4dd5e84f60dfe 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -5155,7 +5155,7 @@ struct OpenMPThreadprivate { struct OpenMPDeclarativeAllocate { TUPLE_CLASS_BOILERPLATE(OpenMPDeclarativeAllocate); CharBlock source; - std::tuple t; + std::tuple, OmpClauseList> t; }; struct OpenMPDeclarativeConstruct { diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h index 032944d8be370..14a4f0e93bda5 100644 --- a/flang/include/flang/Semantics/openmp-utils.h +++ b/flang/include/flang/Semantics/openmp-utils.h @@ -72,6 +72,8 @@ const parser::OmpObject *GetArgumentObject(const parser::OmpArgument &argument); bool IsCommonBlock(const Symbol &sym); bool IsExtendedListItem(const Symbol &sym); bool IsVariableListItem(const Symbol &sym); +bool IsTypeParamInquiry(const Symbol &sym); +bool IsStructureComponent(const Symbol &sym); bool IsVarOrFunctionRef(const MaybeExpr &expr); bool IsMapEnteringType(parser::OmpMapType::Value type); diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index 4159d2e41b78c..a9de26ea09ff8 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -2045,11 +2045,12 @@ TYPE_PARSER(sourced(construct( OmpBlockConstructParser{llvm::omp::Directive::OMPD_critical}))) // 2.11.3 Executable Allocate directive -TYPE_PARSER( - sourced(construct(verbatim("ALLOCATE"_tok), - maybe(parenthesized(Parser{})), Parser{}, - maybe(nonemptyList(Parser{})) / endOmpLine, - statement(allocateStmt)))) +TYPE_PARSER(sourced(construct( + verbatim("ALLOCATE"_tok), maybe(parenthesized(Parser{})), + Parser{}, + maybe(nonemptyList(startOmpLine >> Parser{})) / + endOmpLine, + statement(allocateStmt)))) // 2.8.2 Declare Simd construct TYPE_PARSER(sourced(construct( @@ -2079,7 +2080,8 @@ TYPE_PARSER(sourced( // // 2.11.3 Declarative Allocate directive TYPE_PARSER( sourced(construct(verbatim("ALLOCATE"_tok), - parenthesized(Parser{}), Parser{})) / + maybe(parenthesized(Parser{})), + Parser{})) / lookAhead(endOmpLine / !statement(allocateStmt))) // Assumes Construct diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index 9b38cfc40c5b2..b3a395c4d72e1 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2503,7 +2503,7 @@ class UnparseVisitor { BeginOpenMP(); Word("!$OMP ALLOCATE"); Put(" ("); - Walk(std::get(x.t)); + Walk(std::get>(x.t)); Put(")"); Walk(std::get(x.t)); Put("\n"); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index aaaf1ec5d4626..ece179c4a66fc 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -667,49 +667,6 @@ void OmpStructureChecker::HasInvalidTeamsNesting( } } -void OmpStructureChecker::CheckPredefinedAllocatorRestriction( - const parser::CharBlock &source, const parser::Name &name) { - if (const auto *symbol{name.symbol}) { - const auto *commonBlock{FindCommonBlockContaining(*symbol)}; - const auto &scope{context_.FindScope(symbol->name())}; - const Scope &containingScope{GetProgramUnitContaining(scope)}; - if (!isPredefinedAllocator && - (IsSaved(*symbol) || commonBlock || - containingScope.kind() == Scope::Kind::Module)) { - context_.Say(source, - "If list items within the %s 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"_err_en_US, - ContextDirectiveAsFortran()); - } - } -} - -void OmpStructureChecker::CheckPredefinedAllocatorRestriction( - const parser::CharBlock &source, - const parser::OmpObjectList &ompObjectList) { - for (const auto &ompObject : ompObjectList.v) { - common::visit( - common::visitors{ - [&](const parser::Designator &designator) { - if (const auto *dataRef{ - std::get_if(&designator.u)}) { - if (const auto *name{std::get_if(&dataRef->u)}) { - CheckPredefinedAllocatorRestriction(source, *name); - } - } - }, - [&](const parser::Name &name) { - CheckPredefinedAllocatorRestriction(source, name); - }, - [&](const parser::OmpObject::Invalid &invalid) {}, - }, - ompObject.u); - } -} - void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_hint); auto &dirCtx{GetContext()}; @@ -1710,12 +1667,51 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) { dirContext_.pop_back(); } +static std::pair +getAllocateStmtAndSource(const parser::Statement &stmt) { + return {&stmt.statement, stmt.source}; +} + +static std::pair +getAllocateStmtAndSource(const parser::ExecutionPartConstruct *epc) { + if (SourcedActionStmt as{GetActionStmt(epc)}) { + using IndirectionAllocateStmt = common::Indirection; + if (auto *indirect{std::get_if(&as.stmt->u)}) { + return {&indirect->value(), as.source}; + } + } + return {nullptr, ""}; +} + +// Collect symbols that correspond to non-component objects on the +// ALLOCATE statement. +static UnorderedSymbolSet GetNonComponentSymbols( + const parser::AllocateStmt &stmt) { + UnorderedSymbolSet symbols; + for (auto &alloc : std::get>(stmt.t)) { + auto &object{std::get(alloc.t)}; + if (auto *name{std::get_if(&object.u)}) { + if (name->symbol) { + symbols.insert(name->symbol->GetUltimate()); + } + } + } + return symbols; +} + +static const parser::OmpObjectList &GetObjectsOrEmpty( + const std::optional &maybeObjects) { + static parser::OmpObjectList empty{std::list{}}; + if (maybeObjects) { + return *maybeObjects; + } + return empty; +} + 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 maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) { // Return "true" if the ALLOCATOR clause was provided with an argument @@ -1741,7 +1737,17 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, return true; }}; - const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)}; + const auto *allocator{[&]() { + // Can't use FindClause in Enter (because clauses haven't been visited + // yet). + for (const parser::OmpClause &c : clauses.v) { + if (c.Id() == llvm::omp::Clause::OMPC_allocator) { + return &c; + } + } + return static_cast(nullptr); + }()}; + if (InTargetRegion()) { bool hasDynAllocators{ HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)}; @@ -1753,61 +1759,85 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, auto maybePredefined{maybeHasPredefinedAllocator(allocator)}; - for (auto &[symbol, source] : symbols) { + unsigned version{context_.langOptions().OpenMPVersion}; + std::string condStr{version == 50 + ? "a named common block, has SAVE attribute or is declared in the " + "scope of a module" + : "a named common block or has SAVE attribute"}; + + auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) { if (!inExecutableAllocate_) { - if (symbol->owner() != thisScope) { + // For structure members, the scope is the derived type, which is + // never "this" scope. Ignore this check for members, they will be + // flagged anyway. + if (symbol.owner() != thisScope && !IsStructureComponent(symbol)) { 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)) { + 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()) { + if (symbol.GetUltimate().has()) { context_.Say(source, "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US); } - if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) { + bool inModule{ + version == 50 && symbol.owner().kind() == Scope::Kind::Module}; + if (symbol.attrs().test(Attr::SAVE) || IsCommonBlock(symbol) || inModule) { 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); + "If a list item is %s, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US, + condStr); } else if (!maybePredefined) { 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"_err_en_US); + "If a list item is %s, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US, + condStr); } } - if (FindCommonBlockContaining(*symbol)) { + 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); } + }}; + + for (const parser::OmpObject &object : objects.v) { + parser::CharBlock objSource{[&]() { + if (auto &&maybeSource{GetObjectSource(object)}) { + return *maybeSource; + } + return source; + }()}; + if (const Symbol *symbol{GetObjectSymbol(object)}) { + if (!IsTypeParamInquiry(*symbol)) { + checkSymbol(*symbol, objSource); + } + CheckVarIsNotPartOfAnotherVar(source, object); + } } - CheckVarIsNotPartOfAnotherVar(source, objects); } void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { const auto &dir{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); -} -void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { if (!inExecutableAllocate_) { const auto &dir{std::get(x.t)}; - const auto &clauseList{std::get(x.t)}; - const auto &objectList{std::get(x.t)}; + const auto &clauses{std::get(x.t)}; + const auto &objects{ + GetObjectsOrEmpty(std::get>(x.t))}; - isPredefinedAllocator = true; - CheckAllocateDirective(dir.source, objectList, clauseList); + CheckAllocateDirective(dir.source, objects, clauses); } +} + +void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { dirContext_.pop_back(); } void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_allocator); - // Note: Predefined allocators are stored in ScalarExpr as numbers - // whereas custom allocators are stored as strings, so if the ScalarExpr - // actually has an int value, then it must be a predefined allocator - isPredefinedAllocator = GetIntValue(x.v).has_value(); RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v); } @@ -1823,16 +1853,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) { "The alignment value should be a constant positive integer"_err_en_US); } } - // The simple and complex modifiers have the same structure. They only - // differ in their syntax. - if (auto *alloc{OmpGetUniqueModifier( - modifiers)}) { - isPredefinedAllocator = GetIntValue(alloc->v).has_value(); - } - if (auto *alloc{OmpGetUniqueModifier( - modifiers)}) { - isPredefinedAllocator = GetIntValue(alloc->v).has_value(); - } } } @@ -2115,44 +2135,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) { } } -// Goes through the names in an OmpObjectList and checks if each name appears -// in the given allocate statement -void OmpStructureChecker::CheckAllNamesInAllocateStmt( - const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList, - const parser::AllocateStmt &allocate) { - for (const auto &obj : ompObjectList.v) { - if (const auto *d{std::get_if(&obj.u)}) { - if (const auto *ref{std::get_if(&d->u)}) { - if (const auto *n{std::get_if(&ref->u)}) { - CheckNameInAllocateStmt(source, *n, allocate); - } - } - } - } -} - -void OmpStructureChecker::CheckNameInAllocateStmt( - const parser::CharBlock &source, const parser::Name &name, - const parser::AllocateStmt &allocate) { - for (const auto &allocation : - std::get>(allocate.t)) { - const auto &allocObj = std::get(allocation.t); - if (const auto *n{std::get_if(&allocObj.u)}) { - if (n->source == name.source) { - return; - } - } - } - unsigned version{context_.langOptions().OpenMPVersion}; - context_.Say(source, - "Object '%s' in %s directive not " - "found in corresponding ALLOCATE statement"_err_en_US, - name.ToString(), - parser::ToUpperCaseLetters( - llvm::omp::getOpenMPDirectiveName(GetContext().directive, version) - .str())); -} - void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { inExecutableAllocate_ = true; const auto &dir{std::get(x.t)}; @@ -2164,34 +2146,10 @@ 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); } - const auto &allocateStmt = - std::get>(x.t).statement; - if (const auto &list{std::get>(x.t)}) { - CheckAllNamesInAllocateStmt( - std::get(x.t).source, *list, allocateStmt); - } - if (const auto &subDirs{ - std::get>>( - x.t)}) { - for (const auto &dalloc : *subDirs) { - CheckAllNamesInAllocateStmt(std::get(dalloc.t).source, - std::get(dalloc.t), allocateStmt); - } - } - - isPredefinedAllocator = true; -} - -void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { - parser::OmpObjectList empty{std::list{}}; - auto &objects{[&]() -> const parser::OmpObjectList & { - if (auto &objects{std::get>(x.t)}) { - return *objects; - } else { - return empty; - } - }()}; + auto &objects{ + GetObjectsOrEmpty(std::get>(x.t))}; auto &clauses{std::get(x.t)}; + CheckAllocateDirective( std::get(x.t).source, objects, clauses); @@ -2201,82 +2159,171 @@ void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { for (const auto &dalloc : *subDirs) { const auto &dir{std::get(x.t)}; const auto &clauses{std::get(dalloc.t)}; - const auto &objects{std::get(dalloc.t)}; + const auto &objects{GetObjectsOrEmpty( + std::get>(dalloc.t))}; CheckAllocateDirective(dir.source, objects, clauses); } } +} + +void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { + auto [allocStmt, allocSource]{getAllocateStmtAndSource( + std::get>(x.t))}; + + UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; + SymbolSourceMap directiveSyms; + auto &objects{ + GetObjectsOrEmpty(std::get>(x.t))}; + auto emptyListCount{static_cast(objects.v.empty())}; + auto checkObjects{[&](const parser::OmpObjectList &objects, + parser::CharBlock dirSource, + parser::CharBlock allocSource) { + for (const parser::OmpObject &object : objects.v) { + parser::CharBlock objSource{[&]() { + if (auto &&maybeSource{GetObjectSource(object)}) { + return *maybeSource; + } + return dirSource; + }()}; + if (auto *sym{GetObjectSymbol(object)}) { + // Ignore these checks for structure members. They are not allowed + // in the first place, so don't tell the users that they nened to + // be specified somewhere, + if (IsStructureComponent(*sym)) { + continue; + } + if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) { + parser::MessageFormattedText txt( + "A list item on an executable ALLOCATE may only be specified once"_err_en_US); + parser::Message message(objSource, txt); + message.Attach(f->second, "The list item was specified here"_en_US); + context_.Say(std::move(message)); + } else { + directiveSyms.insert(std::make_pair(sym, objSource)); + } + + if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) { + context_ + .Say(objSource, + "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US) + .Attach(allocSource, "The ALLOCATE statement"_en_US); + } + } + } + }}; + + checkObjects(objects, std::get(x.t).source, allocSource); + + const auto &subDirs{ + std::get>>( + x.t)}; + if (!subDirs) { + inExecutableAllocate_ = false; + dirContext_.pop_back(); + return; + } + + for (const parser::OpenMPDeclarativeAllocate &ompAlloc : *subDirs) { + parser::CharBlock dirSource{std::get(ompAlloc.t).source}; + auto &objects{GetObjectsOrEmpty( + std::get>(ompAlloc.t))}; + if (objects.v.empty()) { + // Only show the message once per construct. + if (++emptyListCount == 2 && subDirs->size() >= 1) { + context_.Say(dirSource, + "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US); + } + } + checkObjects(objects, dirSource, allocSource); + } - dirContext_.pop_back(); inExecutableAllocate_ = false; + dirContext_.pop_back(); } void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { - isPredefinedAllocator = true; - - const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; - auto &block{std::get(x.t)}; + const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; + const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; PushContextAndClauseSets( - dirSpec.DirName().source, llvm::omp::Directive::OMPD_allocators); + dirName.source, llvm::omp::Directive::OMPD_allocators); - if (block.empty()) { - context_.Say(dirSpec.source, - "The ALLOCATORS construct should contain a single ALLOCATE statement"_err_en_US); + std::vector allocs; + for (const auto &clause : beginSpec.Clauses().v) { + auto *alloc{std::get_if(&clause.u)}; + if (!alloc) { + continue; + } + using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; + using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; + + if (InTargetRegion()) { + auto &modifiers{OmpGetModifiers(alloc->v)}; + bool hasAllocator{ + OmpGetUniqueModifier(modifiers) || + OmpGetUniqueModifier(modifiers)}; + bool hasDynAllocators{ + HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)}; + if (!hasAllocator && !hasDynAllocators) { + context_.Say(clause.source, + "An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US); + } + } + } + + auto &body{std::get(x.t)}; + // The parser should put at most one statement in the body. + assert(body.size() <= 1 && "Malformed body in allocators"); + if (body.empty()) { + context_.Say(dirName.source, + "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); return; } - omp::SourcedActionStmt action{omp::GetActionStmt(block)}; - const auto *allocate{ - action ? parser::Unwrap(action.stmt) : nullptr}; - - if (allocate) { - for (const auto &clause : dirSpec.Clauses().v) { - if (auto *alloc{std::get_if(&clause.u)}) { - CheckAllNamesInAllocateStmt( - x.source, std::get(alloc->v.t), *allocate); - - using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; - using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; - - auto &modifiers{OmpGetModifiers(alloc->v)}; - bool hasAllocator{ - OmpGetUniqueModifier(modifiers) || - OmpGetUniqueModifier(modifiers)}; - - // TODO: As with allocate directive, exclude the case when a requires - // directive with the dynamic_allocators clause is present in - // the same compilation unit (OMP5.0 2.11.3). - if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && - !hasAllocator) { - context_.Say(x.source, - "ALLOCATORS directives that appear in a TARGET region must specify an allocator"_err_en_US); - } + auto [allocStmt, allocSource]{getAllocateStmtAndSource(&body.front())}; + if (!allocStmt) { + parser::CharBlock source{[&]() { + if (auto &&maybeSource{parser::GetSource(body.front())}) { + return *maybeSource; } - } - } else { - const parser::CharBlock &source = action ? action.source : x.source; + return dirName.source; + }()}; context_.Say(source, - "The body of the ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); + "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); + return; } - for (const auto &clause : dirSpec.Clauses().v) { - if (const auto *allocClause{ - parser::Unwrap(clause)}) { - CheckVarIsNotPartOfAnotherVar( - dirSpec.source, std::get(allocClause->v.t)); + UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; + for (const auto &clause : beginSpec.Clauses().v) { + auto *alloc{std::get_if(&clause.u)}; + if (!alloc) { + continue; + } + for (auto &object : DEREF(GetOmpObjectList(clause)).v) { + CheckVarIsNotPartOfAnotherVar(dirName.source, object); + if (auto *symbol{GetObjectSymbol(object)}) { + if (IsStructureComponent(*symbol)) { + continue; + } + parser::CharBlock source{[&]() { + if (auto &&objectSource{GetObjectSource(object)}) { + return *objectSource; + } + return clause.source; + }()}; + if (!IsTypeParamInquiry(*symbol)) { + if (auto f{allocateSyms.find(*symbol)}; f == allocateSyms.end()) { + context_ + .Say(source, + "A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement"_err_en_US) + .Attach(allocSource, "The ALLOCATE statement"_en_US); + } + } + } } } } void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) { - const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; - - for (const auto &clause : dirSpec.Clauses().v) { - if (const auto *allocClause{ - std::get_if(&clause.u)}) { - CheckPredefinedAllocatorRestriction( - dirSpec.source, std::get(allocClause->v.t)); - } - } dirContext_.pop_back(); } diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 7426559e77ff7..6feb1d149c4fd 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -325,11 +325,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase { const std::optional &maybeClauses); void CheckCancellationNest( const parser::CharBlock &source, llvm::omp::Directive type); - void CheckAllNamesInAllocateStmt(const parser::CharBlock &source, - const parser::OmpObjectList &ompObjectList, - const parser::AllocateStmt &allocate); - void CheckNameInAllocateStmt(const parser::CharBlock &source, - const parser::Name &ompObject, const parser::AllocateStmt &allocate); std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x); void CheckReductionObjects( const parser::OmpObjectList &objects, llvm::omp::Clause clauseId); @@ -353,11 +348,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase { const parser::OmpObjectList &ompObjectList); void CheckIfContiguous(const parser::OmpObject &object); const parser::Name *GetObjectName(const parser::OmpObject &object); - void CheckPredefinedAllocatorRestriction(const parser::CharBlock &source, - const parser::OmpObjectList &ompObjectList); - void CheckPredefinedAllocatorRestriction( - const parser::CharBlock &source, const parser::Name &name); - bool isPredefinedAllocator{false}; void CheckAllowedRequiresClause(llvmOmpClause clause); bool deviceConstructFound_{false}; diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 6b304b62ef867..4a40d6eec17bb 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -186,6 +186,23 @@ bool IsExtendedListItem(const Symbol &sym) { return IsVariableListItem(sym) || sym.IsSubprogram(); } +bool IsTypeParamInquiry(const Symbol &sym) { + return common::visit( // + common::visitors{ + [&](const MiscDetails &d) { + return d.kind() == MiscDetails::Kind::KindParamInquiry || + d.kind() == MiscDetails::Kind::LenParamInquiry; + }, + [&](const TypeParamDetails &s) { return true; }, + [&](auto &&) { return false; }, + }, + sym.details()); +} + +bool IsStructureComponent(const Symbol &sym) { + return sym.owner().kind() == Scope::Kind::DerivedType; +} + bool IsVarOrFunctionRef(const MaybeExpr &expr) { if (expr) { return evaluate::UnwrapProcedureRef(*expr) != nullptr || diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 628068f9a9f68..03c8cb0065fd8 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2560,8 +2560,9 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { PushContext(x.source, llvm::omp::Directive::OMPD_allocate); - const auto &list{std::get(x.t)}; - ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective); + if (const auto &list{std::get>(x.t)}) { + ResolveOmpObjectList(*list, Symbol::Flag::OmpDeclarativeAllocateDirective); + } return false; } diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90 index f4f11e229a28b..3f59493713213 100644 --- a/flang/test/Semantics/OpenMP/allocate08.f90 +++ b/flang/test/Semantics/OpenMP/allocate08.f90 @@ -1,11 +1,11 @@ ! REQUIRES: openmp_runtime -! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -! OpenMP Version 5.0 +! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51 +! OpenMP Version 5.1 ! 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 +! common block name, then only predefined memory allocator parameters can be +! used in the allocator clause module AllocateModule INTEGER :: z diff --git a/flang/test/Semantics/OpenMP/allocate09.f90 b/flang/test/Semantics/OpenMP/allocate09.f90 index 0f93a340fe1e4..8b8d07ccd0be8 100644 --- a/flang/test/Semantics/OpenMP/allocate09.f90 +++ b/flang/test/Semantics/OpenMP/allocate09.f90 @@ -23,11 +23,11 @@ subroutine allocate() !$omp allocate allocate(e(5), f(6), g(7)) - !ERROR: Object 'i' in ALLOCATE directive not found in corresponding ALLOCATE statement + !ERROR: A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement !$omp allocate(h, i) allocator(omp_default_mem_alloc) allocate(h(8)) - !ERROR: Object 'j' in ALLOCATE directive not found in corresponding ALLOCATE statement + !ERROR: A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement !$omp allocate(j, k) allocator(omp_default_mem_alloc) !$omp allocate(l) allocator(omp_default_mem_alloc) allocate(k(9), l(10)) diff --git a/flang/test/Semantics/OpenMP/allocate10.f90 b/flang/test/Semantics/OpenMP/allocate10.f90 new file mode 100644 index 0000000000000..a9db7330296ba --- /dev/null +++ b/flang/test/Semantics/OpenMP/allocate10.f90 @@ -0,0 +1,11 @@ +!RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51 + +subroutine f00 + integer, allocatable :: x, y + + continue + !ERROR: If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items + !$omp allocate + !$omp allocate + allocate(x, y) +end diff --git a/flang/test/Semantics/OpenMP/allocate11.f90 b/flang/test/Semantics/OpenMP/allocate11.f90 new file mode 100644 index 0000000000000..89beaa0450169 --- /dev/null +++ b/flang/test/Semantics/OpenMP/allocate11.f90 @@ -0,0 +1,27 @@ +! REQUIRES: openmp_runtime + +! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=50 +! 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 + +module AllocateModule + INTEGER :: z + !ERROR: If a list item is a named common block, has SAVE attribute or is declared in the scope of a module, an ALLOCATOR clause must be present with a predefined allocator + !$omp allocate(z) +end module + +subroutine allocate(custom_allocator) +use omp_lib +use AllocateModule + integer, SAVE :: x + integer :: w + COMMON /CommonName/ y + + integer(kind=omp_allocator_handle_kind) :: custom_allocator + + !ERROR: If a list item is a named common block, has SAVE attribute or is declared in the scope of a module, an ALLOCATOR clause must be present with a predefined allocator + !$omp allocate(x) +end subroutine allocate diff --git a/flang/test/Semantics/OpenMP/allocators01.f90 b/flang/test/Semantics/OpenMP/allocators01.f90 index ff92fa3b23463..a3342063e25f2 100644 --- a/flang/test/Semantics/OpenMP/allocators01.f90 +++ b/flang/test/Semantics/OpenMP/allocators01.f90 @@ -16,7 +16,7 @@ subroutine allocate() allocate(arr3(3), arr4(4, 4)) !$omp end allocators - !ERROR: Object 'arr1' in ALLOCATORS directive not found in corresponding ALLOCATE statement + !ERROR: A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement !$omp allocators allocate(omp_default_mem_alloc: arr1, arr2) allocate(arr2(2, 2)) diff --git a/flang/test/Semantics/OpenMP/allocators04.f90 b/flang/test/Semantics/OpenMP/allocators04.f90 deleted file mode 100644 index 212e48fbd1b26..0000000000000 --- a/flang/test/Semantics/OpenMP/allocators04.f90 +++ /dev/null @@ -1,31 +0,0 @@ -! REQUIRES: openmp_runtime - -! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=50 -! OpenMP Version 5.2 -! Inherited from 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 -! SAVE and common block names can't be declared as allocatable, only module scope variables are tested - -module AllocateModule - integer, allocatable :: a, b -end module - -subroutine allocate() - use omp_lib - use AllocateModule - - integer(kind=omp_allocator_handle_kind) :: custom_allocator - type(omp_alloctrait) :: trait(1) - - trait(1)%key = fallback - trait(1)%value = default_mem_fb - custom_allocator = omp_init_allocator(omp_default_mem_space, 1, trait) - - !$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 - !$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 efacdfaec7647..f49182f128e74 100644 --- a/flang/test/Semantics/OpenMP/allocators05.f90 +++ b/flang/test/Semantics/OpenMP/allocators05.f90 @@ -17,7 +17,7 @@ subroutine allocate() !$omp target private(a, b) !$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: An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified !$omp allocators allocate(b) allocate(b(LEN)) !$omp end target diff --git a/flang/test/Semantics/OpenMP/allocators07.f90 b/flang/test/Semantics/OpenMP/allocators07.f90 index a28f706965cb1..baaacee8b691e 100644 --- a/flang/test/Semantics/OpenMP/allocators07.f90 +++ b/flang/test/Semantics/OpenMP/allocators07.f90 @@ -5,7 +5,7 @@ subroutine f00 integer, allocatable :: a(:) !$omp allocators allocate(a) -!ERROR: The body of the ALLOCATORS construct should be an ALLOCATE statement +!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement continue end @@ -13,7 +13,7 @@ subroutine f01 implicit none integer, allocatable :: a(:) -!ERROR: The ALLOCATORS construct should contain a single ALLOCATE statement +!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement !$omp allocators allocate(a) !$omp end allocators end @@ -22,6 +22,6 @@ subroutine f02 implicit none integer, allocatable :: a(:) -!ERROR: The ALLOCATORS construct should contain a single ALLOCATE statement +!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement !$omp allocators allocate(a) end From ed75ae6abef64dc248ba2835f5acc19a4f6c8862 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Thu, 30 Oct 2025 10:09:09 -0500 Subject: [PATCH 2/7] Remove unused variable --- flang/lib/Semantics/check-omp-structure.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index ece179c4a66fc..3ea8e5b8cd2b0 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -2247,7 +2247,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { PushContextAndClauseSets( dirName.source, llvm::omp::Directive::OMPD_allocators); - std::vector allocs; for (const auto &clause : beginSpec.Clauses().v) { auto *alloc{std::get_if(&clause.u)}; if (!alloc) { From b3a69f5dabb6e8d6801b47eeb0b9de9023fcda2e Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Thu, 25 Sep 2025 13:34:22 -0500 Subject: [PATCH 3/7] [flang][OpenMP] Use OmpDirectiveSpecification in ALLOCATE The ALLOCATE directive has two forms: - A declarative form with a standalone directive: !$OMP ALLOCATE (variable-list-item...) - An executable form that consists of several diretives followed by an ALLOCATE statement: !$OMP ALLOCATE (variable-list-item...) !$OMP ALLOCATE (variable-list-item...) ... ALLOCATE (...) The second form was deprecated in OpenMP 5.2 in favor of the ALLOCATORS construct. Since in the parse tree every type corresponding to a directive only corresponds to a single directive, the executable form is represented by a sequence of nested OmpAlocateDirectives, e.g. !$OMP ALLOCATE(x) !$OMP ALLOCATE(y) ALLOCATE(x, y) will become OmpAllocateDirective |- ALLOCATE(x) // begin directive `- OmpAllocateDirective // block |- ALLOCATE(y) // begin directive `- ALLOCATE(x, y) // block With this change all AST nodes for directives use OmpDirectiveSpecification as the directive representation. --- flang/examples/FeatureList/FeatureList.cpp | 3 +- flang/include/flang/Parser/dump-parse-tree.h | 3 +- flang/include/flang/Parser/openmp-utils.h | 31 +- flang/include/flang/Parser/parse-tree.h | 56 ++-- flang/lib/Lower/OpenMP/OpenMP.cpp | 12 +- flang/lib/Parser/openmp-parsers.cpp | 46 +-- flang/lib/Parser/openmp-utils.cpp | 39 +++ flang/lib/Parser/unparse.cpp | 28 +- flang/lib/Semantics/canonicalize-omp.cpp | 156 ++++++++-- flang/lib/Semantics/check-omp-structure.cpp | 292 +++++++++--------- flang/lib/Semantics/check-omp-structure.h | 27 +- flang/lib/Semantics/resolve-directives.cpp | 58 ++-- flang/lib/Semantics/resolve-names.cpp | 4 +- .../Todo/omp-declarative-allocate-align.f90 | 2 +- .../OpenMP/Todo/omp-declarative-allocate.f90 | 2 +- .../Parser/OpenMP/allocate-align-tree.f90 | 48 +-- .../Parser/OpenMP/allocate-tree-spec-part.f90 | 63 ++-- flang/test/Parser/OpenMP/allocate-tree.f90 | 80 ++--- flang/test/Parser/OpenMP/allocate-unparse.f90 | 18 +- .../Semantics/OpenMP/allocate-align01.f90 | 2 +- .../Semantics/OpenMP/allocate-directive.f90 | 2 +- flang/test/Semantics/OpenMP/allocate01.f90 | 2 +- flang/test/Semantics/OpenMP/allocate02.f90 | 1 + flang/test/Semantics/OpenMP/allocate03.f90 | 1 + flang/test/Semantics/OpenMP/allocate06.f90 | 2 +- flang/test/Semantics/OpenMP/allocate10.f90 | 2 +- flang/test/Semantics/OpenMP/allocate12.f90 | 16 + 27 files changed, 585 insertions(+), 411 deletions(-) create mode 100644 flang/test/Semantics/OpenMP/allocate12.f90 diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp index 225a6558ef956..ef58da61e371b 100644 --- a/flang/examples/FeatureList/FeatureList.cpp +++ b/flang/examples/FeatureList/FeatureList.cpp @@ -445,6 +445,7 @@ struct NodeVisitor { READ_FEATURE(ObjectDecl) READ_FEATURE(OldParameterStmt) READ_FEATURE(OmpAlignedClause) + READ_FEATURE(OmpAllocateDirective) READ_FEATURE(OmpBeginDirective) READ_FEATURE(OmpBeginLoopDirective) READ_FEATURE(OmpBeginSectionsDirective) @@ -541,7 +542,6 @@ struct NodeVisitor { READ_FEATURE(OpenMPCancellationPointConstruct) READ_FEATURE(OpenMPConstruct) READ_FEATURE(OpenMPCriticalConstruct) - READ_FEATURE(OpenMPDeclarativeAllocate) READ_FEATURE(OpenMPDeclarativeConstruct) READ_FEATURE(OpenMPDeclareReductionConstruct) READ_FEATURE(OpenMPDeclareSimdConstruct) @@ -550,7 +550,6 @@ struct NodeVisitor { READ_FEATURE(OmpAtomicDefaultMemOrderClause) READ_FEATURE(OpenMPFlushConstruct) READ_FEATURE(OpenMPLoopConstruct) - READ_FEATURE(OpenMPExecutableAllocate) READ_FEATURE(OpenMPAllocatorsConstruct) READ_FEATURE(OpenMPRequiresConstruct) READ_FEATURE(OpenMPSimpleStandaloneConstruct) diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h index a7398a4ef970f..de2716410d6cd 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -512,6 +512,7 @@ class ParseTreeDumper { NODE(parser, OmpAlignModifier) NODE(parser, OmpAllocateClause) NODE(OmpAllocateClause, Modifier) + NODE(parser, OmpAllocateDirective) NODE(parser, OmpAllocatorComplexModifier) NODE(parser, OmpAllocatorSimpleModifier) NODE(parser, OmpAlwaysModifier) @@ -739,7 +740,6 @@ class ParseTreeDumper { NODE(parser, OpenMPCancellationPointConstruct) NODE(parser, OpenMPConstruct) NODE(parser, OpenMPCriticalConstruct) - NODE(parser, OpenMPDeclarativeAllocate) NODE(parser, OpenMPDeclarativeAssumes) NODE(parser, OpenMPDeclarativeConstruct) NODE(parser, OpenMPDeclareMapperConstruct) @@ -748,7 +748,6 @@ class ParseTreeDumper { NODE(parser, OpenMPDeclareTargetConstruct) NODE(parser, OpenMPDepobjConstruct) NODE(parser, OpenMPDispatchConstruct) - NODE(parser, OpenMPExecutableAllocate) NODE(parser, OpenMPFlushConstruct) NODE(parser, OpenMPGroupprivate) NODE(parser, OpenMPLoopConstruct) diff --git a/flang/include/flang/Parser/openmp-utils.h b/flang/include/flang/Parser/openmp-utils.h index 49db091af93a7..8fa4a84aff06d 100644 --- a/flang/include/flang/Parser/openmp-utils.h +++ b/flang/include/flang/Parser/openmp-utils.h @@ -22,6 +22,7 @@ #include #include #include +#include namespace Fortran::parser::omp { @@ -33,23 +34,6 @@ template constexpr auto addr_if(const std::optional &x) { } namespace detail { -using D = llvm::omp::Directive; - -template // -struct ConstructId { - static constexpr llvm::omp::Directive id{D::OMPD_unknown}; -}; - -#define MAKE_CONSTR_ID(Construct, Id) \ - template <> struct ConstructId { \ - static constexpr llvm::omp::Directive id{Id}; \ - } - -MAKE_CONSTR_ID(OpenMPDeclarativeAllocate, D::OMPD_allocate); -MAKE_CONSTR_ID(OpenMPExecutableAllocate, D::OMPD_allocate); - -#undef MAKE_CONSTR_ID - struct DirectiveNameScope { static OmpDirectiveName MakeName(CharBlock source = {}, llvm::omp::Directive id = llvm::omp::Directive::OMPD_unknown) { @@ -97,9 +81,6 @@ struct DirectiveNameScope { } else if constexpr (TupleTrait) { if constexpr (std::is_base_of_v) { return std::get(x.t).DirName(); - } else if constexpr (std::is_same_v || - std::is_same_v) { - return MakeName(std::get(x.t).source, ConstructId::id); } else { return GetFromTuple( x.t, std::make_index_sequence>{}); @@ -139,6 +120,9 @@ template OmpDirectiveName GetOmpDirectiveName(const T &x) { return detail::DirectiveNameScope::GetOmpDirectiveName(x); } +const OpenMPDeclarativeConstruct *GetOmp(const DeclarationConstruct &x); +const OpenMPConstruct *GetOmp(const ExecutionPartConstruct &x); + const OmpObjectList *GetOmpObjectList(const OmpClause &clause); template @@ -158,6 +142,13 @@ const OmpCombinerExpression *GetCombinerExpr( const OmpReductionSpecifier &rspec); const OmpInitializerExpression *GetInitializerExpr(const OmpClause &init); +struct OmpAllocateInfo { + std::vector dirs; + const ExecutionPartConstruct *body{nullptr}; +}; + +OmpAllocateInfo SplitOmpAllocate(const OmpAllocateDirective &x); + } // namespace Fortran::parser::omp #endif // FORTRAN_PARSER_OPENMP_UTILS_H diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 4dd5e84f60dfe..8c7578f7a1941 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -5151,17 +5151,42 @@ struct OpenMPThreadprivate { CharBlock source; }; -// 2.11.3 allocate -> ALLOCATE (variable-name-list) [clause] -struct OpenMPDeclarativeAllocate { - TUPLE_CLASS_BOILERPLATE(OpenMPDeclarativeAllocate); - CharBlock source; - std::tuple, OmpClauseList> t; +// Ref: [4.5:310-312], [5.0:156-158], [5.1:181-184], [5.2:176-177], +// [6.0:310-312] +// +// allocate-directive -> +// ALLOCATE (variable-list-item...) | // since 4.5 +// ALLOCATE (variable-list-item...) // since 5.0, until 5.1 +// ... +// allocate-stmt +// +// The first form is the "declarative-allocate", and is a declarative +// directive. The second is the "executable-allocate" and is an executable +// directive. The executable form was deprecated in 5.2. +// +// The executable-allocate consists of several ALLOCATE directives. Since +// in the parse tree every type corresponding to a directive only corresponds +// to a single directive, the executable form is represented by a sequence +// of nested OmpAlocateDirectives, e.g. +// !$OMP ALLOCATE(x) +// !$OMP ALLOCATE(y) +// ALLOCATE(x, y) +// will become +// OmpAllocateDirective +// |- ALLOCATE(x) // begin directive +// `- OmpAllocateDirective // block +// |- ALLOCATE(y) // begin directive +// `- ALLOCATE(x, y) // block +// +// The block in the declarative-allocate will be empty. +struct OmpAllocateDirective : public OmpBlockConstruct { + INHERITED_TUPLE_CLASS_BOILERPLATE(OmpAllocateDirective, OmpBlockConstruct); }; struct OpenMPDeclarativeConstruct { UNION_CLASS_BOILERPLATE(OpenMPDeclarativeConstruct); CharBlock source; - std::variant ALLOCATE [(variable-name-list)] [clause] -// [ALLOCATE (variable-name-list) [clause] [...]] -// allocate-statement -// clause -> allocator-clause -struct OpenMPExecutableAllocate { - TUPLE_CLASS_BOILERPLATE(OpenMPExecutableAllocate); - CharBlock source; - std::tuple, OmpClauseList, - std::optional>, - Statement> - t; -}; - // Ref: [5.2:180-181], [6.0:315] // // allocators-construct -> @@ -5342,9 +5354,9 @@ struct OpenMPConstruct { UNION_CLASS_BOILERPLATE(OpenMPConstruct); std::variant + OpenMPAtomicConstruct, OmpAllocateDirective, OpenMPDispatchConstruct, + OpenMPUtilityConstruct, OpenMPAllocatorsConstruct, OpenMPAssumeConstruct, + OpenMPCriticalConstruct> u; }; diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index 71067283d13f7..b901f24ae366e 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -3506,9 +3506,9 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval, - const parser::OpenMPDeclarativeAllocate &declarativeAllocate) { + const parser::OmpAllocateDirective &allocate) { if (!semaCtx.langOptions().OpenMPSimd) - TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate"); + TODO(converter.getCurrentLocation(), "OmpAllocateDirective"); } static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, @@ -3899,14 +3899,6 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, TODO(converter.getCurrentLocation(), "OpenMPDispatchConstruct"); } -static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, - semantics::SemanticsContext &semaCtx, - lower::pft::Evaluation &eval, - const parser::OpenMPExecutableAllocate &execAllocConstruct) { - if (!semaCtx.langOptions().OpenMPSimd) - TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate"); -} - static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval, diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp index a9de26ea09ff8..4374acbbe51bf 100644 --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -1778,6 +1778,31 @@ struct OmpBlockConstructParser { llvm::omp::Directive dir_; }; +struct OmpDeclarativeAllocateParser { + using resultType = OmpAllocateDirective; + + std::optional Parse(ParseState &state) const { + constexpr llvm::omp::Directive dir{llvm::omp::Directive::OMPD_allocate}; + if (auto &&begin{attempt(OmpBeginDirectiveParser(dir)).Parse(state)}) { + Block empty; + auto end{maybe(OmpEndDirectiveParser{dir}).Parse(state)}; + return OmpAllocateDirective{std::move(*begin), std::move(empty), + llvm::transformOptional(std::move(*end), + [](auto &&s) { return OmpEndDirective(std::move(s)); })}; + } + return std::nullopt; + } +}; + +struct OmpExecutableAllocateParser { + using resultType = OmpAllocateDirective; + + std::optional Parse(ParseState &state) const { + OmpStatementConstructParser p{llvm::omp::Directive::OMPD_allocate}; + return construct(p).Parse(state); + } +}; + TYPE_PARSER(sourced(construct( OmpStatementConstructParser{llvm::omp::Directive::OMPD_allocators}))) @@ -2044,14 +2069,6 @@ TYPE_PARSER(construct(OmpStylizedExpressionParser{})) TYPE_PARSER(sourced(construct( OmpBlockConstructParser{llvm::omp::Directive::OMPD_critical}))) -// 2.11.3 Executable Allocate directive -TYPE_PARSER(sourced(construct( - verbatim("ALLOCATE"_tok), maybe(parenthesized(Parser{})), - Parser{}, - maybe(nonemptyList(startOmpLine >> Parser{})) / - endOmpLine, - statement(allocateStmt)))) - // 2.8.2 Declare Simd construct TYPE_PARSER(sourced(construct( predicated(Parser{}, @@ -2077,13 +2094,6 @@ TYPE_PARSER(sourced( // IsDirective(llvm::omp::Directive::OMPD_threadprivate)) >= Parser{}))) -// 2.11.3 Declarative Allocate directive -TYPE_PARSER( - sourced(construct(verbatim("ALLOCATE"_tok), - maybe(parenthesized(Parser{})), - Parser{})) / - lookAhead(endOmpLine / !statement(allocateStmt))) - // Assumes Construct TYPE_PARSER(sourced(construct( predicated(OmpDirectiveNameParser{}, @@ -2106,7 +2116,7 @@ TYPE_PARSER( construct( Parser{}) || construct( - Parser{}) || + sourced(OmpDeclarativeAllocateParser{})) || construct( Parser{}) || construct( @@ -2194,6 +2204,8 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US, withMessage("expected OpenMP construct"_err_en_US, first(construct(Parser{}), construct(Parser{}), + construct( + sourced(OmpExecutableAllocateParser{})), construct(Parser{}), // OmpBlockConstruct is attempted before // OpenMPStandaloneConstruct to resolve !$OMP ORDERED @@ -2201,9 +2213,7 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US, construct(Parser{}), construct(Parser{}), construct(Parser{}), - construct(Parser{}), construct(Parser{}), - construct(Parser{}), construct(Parser{}), construct(Parser{})))) diff --git a/flang/lib/Parser/openmp-utils.cpp b/flang/lib/Parser/openmp-utils.cpp index 95ad3f60770f5..b9d3763cdd06d 100644 --- a/flang/lib/Parser/openmp-utils.cpp +++ b/flang/lib/Parser/openmp-utils.cpp @@ -22,6 +22,25 @@ namespace Fortran::parser::omp { +const OpenMPDeclarativeConstruct *GetOmp(const DeclarationConstruct &x) { + if (auto *y = std::get_if(&x.u)) { + if (auto *z{std::get_if>( + &y->u)}) { + return &z->value(); + } + } + return nullptr; +} + +const OpenMPConstruct *GetOmp(const ExecutionPartConstruct &x) { + if (auto *y{std::get_if(&x.u)}) { + if (auto *z{std::get_if>(&y->u)}) { + return &z->value(); + } + } + return nullptr; +} + const OmpObjectList *GetOmpObjectList(const OmpClause &clause) { // Clauses with OmpObjectList as its data member using MemberObjectListClauses = std::tuple(x.t)}; + if (!body.empty()) { + if (auto *omp{GetOmp(body.front())}) { + if (auto *ad{std::get_if(&omp->u)}) { + return SplitOmpAllocateHelper(n, *ad); + } + } + n.body = &body.front(); + } +} + +OmpAllocateInfo SplitOmpAllocate(const OmpAllocateDirective &x) { + OmpAllocateInfo info; + SplitOmpAllocateHelper(info, x); + return info; +} + } // namespace Fortran::parser::omp diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index b3a395c4d72e1..84123030195e9 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2482,32 +2482,8 @@ class UnparseVisitor { Unparse(static_cast(x)); } - void Unparse(const OpenMPExecutableAllocate &x) { - const auto &fields = - std::get>>( - x.t); - if (fields) { - for (const auto &decl : *fields) { - Walk(decl); - } - } - BeginOpenMP(); - Word("!$OMP ALLOCATE"); - Walk(" (", std::get>(x.t), ")"); - Walk(std::get(x.t)); - Put("\n"); - EndOpenMP(); - Walk(std::get>(x.t)); - } - void Unparse(const OpenMPDeclarativeAllocate &x) { - BeginOpenMP(); - Word("!$OMP ALLOCATE"); - Put(" ("); - Walk(std::get>(x.t)); - Put(")"); - Walk(std::get(x.t)); - Put("\n"); - EndOpenMP(); + void Unparse(const OmpAllocateDirective &x) { + Unparse(static_cast(x)); } void Unparse(const OpenMPAllocatorsConstruct &x) { Unparse(static_cast(x)); diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp index c884658bf464a..039dd7f564758 100644 --- a/flang/lib/Semantics/canonicalize-omp.cpp +++ b/flang/lib/Semantics/canonicalize-omp.cpp @@ -51,8 +51,6 @@ class CanonicalizationOfOmp { } // Block list } - void Post(parser::ExecutionPart &body) { RewriteOmpAllocations(body); } - // Pre-visit all constructs that have both a specification part and // an execution part, and store the connection between the two. bool Pre(parser::BlockConstruct &x) { @@ -88,6 +86,7 @@ class CanonicalizationOfOmp { void Post(parser::SpecificationPart &spec) { CanonicalizeUtilityConstructs(spec); + CanonicalizeAllocateDirectives(spec); } void Post(parser::OmpMapClause &map) { CanonicalizeMapModifiers(map); } @@ -239,33 +238,138 @@ class CanonicalizationOfOmp { } } - void RewriteOmpAllocations(parser::ExecutionPart &body) { - // Rewrite leading declarative allocations so they are nested - // within their respective executable allocate directive - // - // Original: - // ExecutionPartConstruct -> OpenMPDeclarativeAllocate - // ExecutionPartConstruct -> OpenMPDeclarativeAllocate - // ExecutionPartConstruct -> OpenMPExecutableAllocate - // - // After rewriting: - // ExecutionPartConstruct -> OpenMPExecutableAllocate - // ExecutionPartConstruct -> OpenMPDeclarativeAllocate - // ExecutionPartConstruct -> OpenMPDeclarativeAllocate - for (auto it = body.v.rbegin(); it != body.v.rend();) { - if (auto *exec = GetOmpIf(*(it++))) { - parser::OpenMPDeclarativeAllocate *decl; - std::list subAllocates; - while (it != body.v.rend() && - (decl = GetOmpIf(*it))) { - subAllocates.push_front(std::move(*decl)); - it = decltype(it)(body.v.erase(std::next(it).base())); + // Canonicalization of allocate directives + // + // In OpenMP 5.0 and 5.1 the allocate directive could either be a declarative + // one or an executable one. As usual in such cases, this poses a problem + // when the directive appears at the boundary between the specification part + // and the execution part. + // The executable form can actually consist of several adjacent directives, + // whereas the declarative form is always standalone. Additionally, the + // executable form must be associated with an allocate statement. + // + // The parser tries to parse declarative statements first, so in the + // following case, the two directives will be declarative, even though + // they should be treated as a single executable form: + // integer, allocatable :: x, y ! Specification + // !$omp allocate(x) + // !$omp allocate(y) + // allocate(x, y) ! Execution + // + void CanonicalizeAllocateDirectives(parser::SpecificationPart &spec) { + auto found = blockForSpec_.find(&spec); + if (found == blockForSpec_.end()) { + // There is no corresponding execution part, so there is nothing to do. + return; + } + parser::Block &block = *found->second; + + auto isAllocateStmt = [](const parser::ExecutionPartConstruct &epc) { + if (auto *ec = std::get_if(&epc.u)) { + if (auto *as = + std::get_if>(&ec->u)) { + return std::holds_alternative< + common::Indirection>(as->statement.u); + } + } + return false; + }; + + if (!block.empty() && isAllocateStmt(block.front())) { + // There are two places where an OpenMP declarative construct can + // show up in the tuple in specification part: + // (1) in std::list, or + // (2) in std::list. + // The case (1) is only possible is the list (2) is empty. + + auto &omps = + std::get>(spec.t); + auto &decls = std::get>(spec.t); + + if (!decls.empty()) { + MakeExecutableAllocateFromDecls(decls, block); + } else { + MakeExecutableAllocateFromOmps(omps, block); + } + } + } + + parser::ExecutionPartConstruct EmbedInExec(parser::OmpAllocateDirective *alo, + parser::ExecutionPartConstruct &&epc) { + // Nest current epc inside the allocate directive. + std::get(alo->t).push_front(std::move(epc)); + // Set the new epc to be the ExecutionPartConstruct made from + // the allocate directive. + parser::OpenMPConstruct opc(std::move(*alo)); + common::Indirection ind(std::move(opc)); + parser::ExecutableConstruct ec(std::move(ind)); + return parser::ExecutionPartConstruct(std::move(ec)); + } + + void MakeExecutableAllocateFromDecls( + std::list &decls, parser::Block &body) { + using OpenMPDeclarativeConstruct = + common::Indirection; + + auto getAllocate = [](parser::DeclarationConstruct *dc) { + if (auto *sc = std::get_if(&dc->u)) { + if (auto *odc = std::get_if(&sc->u)) { + if (auto *alo = + std::get_if(&odc->value().u)) { + return alo; + } + } + } + return static_cast(nullptr); + }; + + std::list::reverse_iterator rlast = [&]() { + for (auto rit = decls.rbegin(), rend = decls.rend(); rit != rend; ++rit) { + if (getAllocate(&*rit) == nullptr) { + return rit; } - if (!subAllocates.empty()) { - std::get>>( - exec->t) = {std::move(subAllocates)}; + } + return decls.rend(); + }(); + + if (rlast != decls.rbegin()) { + // We have already checked that the first statement in body is + // ALLOCATE. + parser::ExecutionPartConstruct epc(std::move(body.front())); + for (auto rit = decls.rbegin(); rit != rlast; ++rit) { + epc = EmbedInExec(getAllocate(&*rit), std::move(epc)); + } + + body.pop_front(); + body.push_front(std::move(epc)); + decls.erase(rlast.base(), decls.end()); + } + } + + void MakeExecutableAllocateFromOmps( + std::list &omps, + parser::Block &body) { + using OpenMPDeclarativeConstruct = parser::OpenMPDeclarativeConstruct; + + std::list::reverse_iterator rlast = [&]() { + for (auto rit = omps.rbegin(), rend = omps.rend(); rit != rend; ++rit) { + if (!std::holds_alternative(rit->u)) { + return rit; } } + return omps.rend(); + }(); + + if (rlast != omps.rbegin()) { + parser::ExecutionPartConstruct epc(std::move(body.front())); + for (auto rit = omps.rbegin(); rit != rlast; ++rit) { + epc = EmbedInExec( + &std::get(rit->u), std::move(epc)); + } + + body.pop_front(); + body.push_front(std::move(epc)); + omps.erase(rlast.base(), omps.end()); } } diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 3ea8e5b8cd2b0..40d574a481582 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -179,6 +179,22 @@ void OmpStructureChecker::Leave(const parser::BlockConstruct &x) { } } +void OmpStructureChecker::Enter(const parser::SpecificationPart &) { + partStack_.push_back(PartKind::SpecificationPart); +} + +void OmpStructureChecker::Leave(const parser::SpecificationPart &) { + partStack_.pop_back(); +} + +void OmpStructureChecker::Enter(const parser::ExecutionPart &) { + partStack_.push_back(PartKind::ExecutionPart); +} + +void OmpStructureChecker::Leave(const parser::ExecutionPart &) { + partStack_.pop_back(); +} + // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. #define CHECK_SIMPLE_CLAUSE(X, Y) \ void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \ @@ -720,18 +736,10 @@ template struct DirectiveSpellingVisitor { return std::get(t).DirName(); } - bool Pre(const parser::OpenMPDeclarativeAllocate &x) { - checker_(std::get(x.t).source, Directive::OMPD_allocate); - return false; - } bool Pre(const parser::OpenMPDispatchConstruct &x) { checker_(GetDirName(x.t).source, Directive::OMPD_dispatch); return false; } - bool Pre(const parser::OpenMPExecutableAllocate &x) { - checker_(std::get(x.t).source, Directive::OMPD_allocate); - return false; - } bool Pre(const parser::OpenMPAllocatorsConstruct &x) { checker_(GetDirName(x.t).source, Directive::OMPD_allocators); return false; @@ -1667,11 +1675,6 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) { dirContext_.pop_back(); } -static std::pair -getAllocateStmtAndSource(const parser::Statement &stmt) { - return {&stmt.statement, stmt.source}; -} - static std::pair getAllocateStmtAndSource(const parser::ExecutionPartConstruct *epc) { if (SourcedActionStmt as{GetActionStmt(epc)}) { @@ -1699,19 +1702,12 @@ static UnorderedSymbolSet GetNonComponentSymbols( return symbols; } -static const parser::OmpObjectList &GetObjectsOrEmpty( - const std::optional &maybeObjects) { - static parser::OmpObjectList empty{std::list{}}; - if (maybeObjects) { - return *maybeObjects; - } - return empty; -} +void OmpStructureChecker::CheckIndividualAllocateDirective( + const parser::OmpAllocateDirective &x, bool isExecutable) { + const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; + const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; -void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, - const parser::OmpObjectList &objects, - const parser::OmpClauseList &clauses) { - const Scope &thisScope{context_.FindScope(source)}; + const Scope &thisScope{context_.FindScope(dirName.source)}; auto maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) { // Return "true" if the ALLOCATOR clause was provided with an argument @@ -1740,7 +1736,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, const auto *allocator{[&]() { // Can't use FindClause in Enter (because clauses haven't been visited // yet). - for (const parser::OmpClause &c : clauses.v) { + for (const parser::OmpClause &c : beginSpec.Clauses().v) { if (c.Id() == llvm::omp::Clause::OMPC_allocator) { return &c; } @@ -1752,7 +1748,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, bool hasDynAllocators{ HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)}; if (!allocator && !hasDynAllocators) { - context_.Say(source, + context_.Say(dirName.source, "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US); } } @@ -1766,7 +1762,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, : "a named common block or has SAVE attribute"}; auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) { - if (!inExecutableAllocate_) { + if (!isExecutable) { // For structure members, the scope is the derived type, which is // never "this" scope. Ignore this check for members, they will be // flagged anyway. @@ -1802,37 +1798,130 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, } }}; - for (const parser::OmpObject &object : objects.v) { - parser::CharBlock objSource{[&]() { - if (auto &&maybeSource{GetObjectSource(object)}) { - return *maybeSource; - } - return source; - }()}; - if (const Symbol *symbol{GetObjectSymbol(object)}) { + for (const parser::OmpArgument &arg : beginSpec.Arguments().v) { + const parser::OmpObject *object{GetArgumentObject(arg)}; + if (!object) { + context_.Say(arg.source, + "An argument to ALLOCATE directive must be a variable list item"_err_en_US); + continue; + } + + if (const Symbol *symbol{GetObjectSymbol(*object)}) { if (!IsTypeParamInquiry(*symbol)) { - checkSymbol(*symbol, objSource); + checkSymbol(*symbol, arg.source); } - CheckVarIsNotPartOfAnotherVar(source, object); + CheckVarIsNotPartOfAnotherVar(dirName.source, *object); } } } -void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { - const auto &dir{std::get(x.t)}; - PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); +void OmpStructureChecker::CheckExecutableAllocateDirective( + const parser::OmpAllocateDirective &x) { + parser::omp::OmpAllocateInfo info{SplitOmpAllocate(x)}; + + auto [allocStmt, allocSource]{getAllocateStmtAndSource(info.body)}; + if (!allocStmt) { + // This has been diagnosed already. + return; + } + + UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; + SymbolSourceMap directiveSyms; + bool hasEmptyList{false}; - if (!inExecutableAllocate_) { - const auto &dir{std::get(x.t)}; - const auto &clauses{std::get(x.t)}; - const auto &objects{ - GetObjectsOrEmpty(std::get>(x.t))}; + for (const parser::OmpAllocateDirective *ompAlloc : info.dirs) { + const parser::OmpDirectiveSpecification &spec{DEREF(ompAlloc).BeginDir()}; + if (spec.Arguments().v.empty()) { + if (hasEmptyList && info.dirs.size() > 1) { + context_.Say(spec.DirName().source, + "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US); + } + hasEmptyList = true; + } + for (const parser::OmpArgument &arg : spec.Arguments().v) { + if (auto *sym{GetArgumentSymbol(arg)}) { + // Ignore these checks for structure members. They are not allowed + // in the first place, so don't tell the users that they nened to + // be specified somewhere, + if (IsStructureComponent(*sym)) { + continue; + } + if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) { + parser::MessageFormattedText txt( + "A list item on an executable ALLOCATE may only be specified once"_err_en_US); + parser::Message message(arg.source, txt); + message.Attach(f->second, "The list item was specified here"_en_US); + context_.Say(std::move(message)); + } else { + directiveSyms.insert(std::make_pair(sym, arg.source)); + } - CheckAllocateDirective(dir.source, objects, clauses); + if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) { + context_ + .Say(arg.source, + "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US) + .Attach(allocSource, "The ALLOCATE statement"_en_US); + } + } + } } } -void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { +void OmpStructureChecker::Enter(const parser::OmpAllocateDirective &x) { + const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; + const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; + PushContextAndClauseSets(dirName.source, dirName.v); + ++allocateDirectiveLevel; + + bool isExecutable{partStack_.back() == PartKind::ExecutionPart}; + + unsigned version{context_.langOptions().OpenMPVersion}; + if (isExecutable && allocateDirectiveLevel == 1 && version >= 52) { + context_.Warn(common::UsageWarning::OpenMPUsage, dirName.source, + "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US); + } + + CheckIndividualAllocateDirective(x, isExecutable); + + if (isExecutable) { + auto isOmpAllocate{[](const parser::ExecutionPartConstruct &epc) { + if (auto *omp{GetOmp(epc)}) { + auto odn{GetOmpDirectiveName(*omp)}; + return odn.v == llvm::omp::Directive::OMPD_allocate; + } + return false; + }}; + + auto &body{std::get(x.t)}; + // The parser should put at most one statement in the body. + assert(body.size() <= 1 && "Multiple statements in allocate"); + if (body.empty()) { + context_.Say(dirName.source, + "An executable ALLOCATE directive must be associated with an ALLOCATE statement"_err_en_US); + } else { + const parser::ExecutionPartConstruct &first{body.front()}; + auto [allocStmt, _]{getAllocateStmtAndSource(&body.front())}; + if (!isOmpAllocate(first) && !allocStmt) { + parser::CharBlock source{[&]() { + if (auto &&maybeSource{parser::GetSource(first)}) { + return *maybeSource; + } + return dirName.source; + }()}; + context_.Say(source, + "The statement associated with executable ALLOCATE directive must be an ALLOCATE statement"_err_en_US); + } + } + } +} + +void OmpStructureChecker::Leave(const parser::OmpAllocateDirective &x) { + bool isExecutable{partStack_.back() == PartKind::ExecutionPart}; + if (isExecutable && allocateDirectiveLevel == 1) { + CheckExecutableAllocateDirective(x); + } + + --allocateDirectiveLevel; dirContext_.pop_back(); } @@ -2135,113 +2224,8 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) { } } -void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { - inExecutableAllocate_ = true; - const auto &dir{std::get(x.t)}; - PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); - - unsigned version{context_.langOptions().OpenMPVersion}; - if (version >= 52) { - context_.Warn(common::UsageWarning::OpenMPUsage, x.source, - "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US); - } - - auto &objects{ - GetObjectsOrEmpty(std::get>(x.t))}; - auto &clauses{std::get(x.t)}; - - CheckAllocateDirective( - std::get(x.t).source, objects, clauses); - - if (const auto &subDirs{ - std::get>>( - x.t)}) { - for (const auto &dalloc : *subDirs) { - const auto &dir{std::get(x.t)}; - const auto &clauses{std::get(dalloc.t)}; - const auto &objects{GetObjectsOrEmpty( - std::get>(dalloc.t))}; - CheckAllocateDirective(dir.source, objects, clauses); - } - } -} - -void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { - auto [allocStmt, allocSource]{getAllocateStmtAndSource( - std::get>(x.t))}; - - UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; - SymbolSourceMap directiveSyms; - auto &objects{ - GetObjectsOrEmpty(std::get>(x.t))}; - auto emptyListCount{static_cast(objects.v.empty())}; - auto checkObjects{[&](const parser::OmpObjectList &objects, - parser::CharBlock dirSource, - parser::CharBlock allocSource) { - for (const parser::OmpObject &object : objects.v) { - parser::CharBlock objSource{[&]() { - if (auto &&maybeSource{GetObjectSource(object)}) { - return *maybeSource; - } - return dirSource; - }()}; - if (auto *sym{GetObjectSymbol(object)}) { - // Ignore these checks for structure members. They are not allowed - // in the first place, so don't tell the users that they nened to - // be specified somewhere, - if (IsStructureComponent(*sym)) { - continue; - } - if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) { - parser::MessageFormattedText txt( - "A list item on an executable ALLOCATE may only be specified once"_err_en_US); - parser::Message message(objSource, txt); - message.Attach(f->second, "The list item was specified here"_en_US); - context_.Say(std::move(message)); - } else { - directiveSyms.insert(std::make_pair(sym, objSource)); - } - - if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) { - context_ - .Say(objSource, - "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US) - .Attach(allocSource, "The ALLOCATE statement"_en_US); - } - } - } - }}; - - checkObjects(objects, std::get(x.t).source, allocSource); - - const auto &subDirs{ - std::get>>( - x.t)}; - if (!subDirs) { - inExecutableAllocate_ = false; - dirContext_.pop_back(); - return; - } - - for (const parser::OpenMPDeclarativeAllocate &ompAlloc : *subDirs) { - parser::CharBlock dirSource{std::get(ompAlloc.t).source}; - auto &objects{GetObjectsOrEmpty( - std::get>(ompAlloc.t))}; - if (objects.v.empty()) { - // Only show the message once per construct. - if (++emptyListCount == 2 && subDirs->size() >= 1) { - context_.Say(dirSource, - "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US); - } - } - checkObjects(objects, dirSource, allocSource); - } - - inExecutableAllocate_ = false; - dirContext_.pop_back(); -} - void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { + const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; PushContextAndClauseSets( diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 6feb1d149c4fd..1b84bc5dda471 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -82,6 +82,11 @@ class OmpStructureChecker : public OmpStructureCheckerBase { bool Enter(const parser::BlockConstruct &); void Leave(const parser::BlockConstruct &); + void Enter(const parser::SpecificationPart &); + void Leave(const parser::SpecificationPart &); + void Enter(const parser::ExecutionPart &); + void Leave(const parser::ExecutionPart &); + void Enter(const parser::OpenMPConstruct &); void Leave(const parser::OpenMPConstruct &); void Enter(const parser::OpenMPInteropConstruct &); @@ -113,8 +118,8 @@ class OmpStructureChecker : public OmpStructureCheckerBase { void Leave(const parser::OmpDeclareVariantDirective &); void Enter(const parser::OpenMPDeclareSimdConstruct &); void Leave(const parser::OpenMPDeclareSimdConstruct &); - void Enter(const parser::OpenMPDeclarativeAllocate &); - void Leave(const parser::OpenMPDeclarativeAllocate &); + void Enter(const parser::OmpAllocateDirective &); + void Leave(const parser::OmpAllocateDirective &); void Enter(const parser::OpenMPDeclareMapperConstruct &); void Leave(const parser::OpenMPDeclareMapperConstruct &); void Enter(const parser::OpenMPDeclareReductionConstruct &); @@ -129,8 +134,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase { void Leave(const parser::OmpErrorDirective &); void Enter(const parser::OmpNothingDirective &); void Leave(const parser::OmpNothingDirective &); - void Enter(const parser::OpenMPExecutableAllocate &); - void Leave(const parser::OpenMPExecutableAllocate &); void Enter(const parser::OpenMPAllocatorsConstruct &); void Leave(const parser::OpenMPAllocatorsConstruct &); void Enter(const parser::OpenMPRequiresConstruct &); @@ -263,9 +266,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 CheckIndividualAllocateDirective( + const parser::OmpAllocateDirective &x, bool isExecutable); + void CheckExecutableAllocateDirective(const parser::OmpAllocateDirective &x); void CheckIteratorRange(const parser::OmpIteratorSpecifier &x); void CheckIteratorModifier(const parser::OmpIterator &x); @@ -373,7 +376,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase { }; int directiveNest_[LastType + 1] = {0}; - bool inExecutableAllocate_{false}; + int allocateDirectiveLevel{0}; parser::CharBlock visitedAtomicSource_; SymbolSourceMap deferredNonVariables_; @@ -382,6 +385,14 @@ class OmpStructureChecker : public OmpStructureCheckerBase { std::vector loopStack_; // Scopes for scoping units. std::vector scopeStack_; + + enum class PartKind : int { + // There are also other "parts", such as internal-subprogram-part, etc, + // but we're keeping track of these two for now. + SpecificationPart, + ExecutionPart, + }; + std::vector partStack_; }; /// Find a duplicate entry in the range, and return an iterator to it. diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 03c8cb0065fd8..deb57e005a352 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -415,6 +415,18 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { return true; } + bool Pre(const parser::SpecificationPart &) { + partStack_.push_back(PartKind::SpecificationPart); + return true; + } + void Post(const parser::SpecificationPart &) { partStack_.pop_back(); } + + bool Pre(const parser::ExecutionPart &) { + partStack_.push_back(PartKind::ExecutionPart); + return true; + } + void Post(const parser::ExecutionPart &) { partStack_.pop_back(); } + bool Pre(const parser::InternalSubprogram &) { // Clear the labels being tracked in the previous scope ClearLabels(); @@ -639,8 +651,7 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { bool Pre(const parser::OpenMPThreadprivate &); void Post(const parser::OpenMPThreadprivate &) { PopContext(); } - bool Pre(const parser::OpenMPDeclarativeAllocate &); - void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); } + bool Pre(const parser::OmpAllocateDirective &); bool Pre(const parser::OpenMPAssumeConstruct &); void Post(const parser::OpenMPAssumeConstruct &) { PopContext(); } @@ -651,9 +662,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { bool Pre(const parser::OpenMPDispatchConstruct &); void Post(const parser::OpenMPDispatchConstruct &) { PopContext(); } - bool Pre(const parser::OpenMPExecutableAllocate &); - void Post(const parser::OpenMPExecutableAllocate &); - bool Pre(const parser::OpenMPAllocatorsConstruct &); void Post(const parser::OpenMPAllocatorsConstruct &); @@ -998,6 +1006,14 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { targetLabels_; parser::CharBlock currentStatementSource_; + enum class PartKind : int { + // There are also other "parts", such as internal-subprogram-part, etc, + // but we're keeping track of these two for now. + SpecificationPart, + ExecutionPart, + }; + std::vector partStack_; + void AddAllocateName(const parser::Name *&object) { allocateNames_.push_back(object); } @@ -2558,11 +2574,24 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { return true; } -bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { +bool OmpAttributeVisitor::Pre(const parser::OmpAllocateDirective &x) { PushContext(x.source, llvm::omp::Directive::OMPD_allocate); - if (const auto &list{std::get>(x.t)}) { - ResolveOmpObjectList(*list, Symbol::Flag::OmpDeclarativeAllocateDirective); + assert(!partStack_.empty() && "Misplaced directive"); + + auto ompFlag{partStack_.back() == PartKind::SpecificationPart + ? Symbol::Flag::OmpDeclarativeAllocateDirective + : Symbol::Flag::OmpExecutableAllocateDirective}; + + parser::omp::OmpAllocateInfo info{parser::omp::SplitOmpAllocate(x)}; + for (const parser::OmpAllocateDirective *ad : info.dirs) { + for (const parser::OmpArgument &arg : ad->BeginDir().Arguments().v) { + if (auto *object{omp::GetArgumentObject(arg)}) { + ResolveOmpObject(*object, ompFlag); + } + } } + + PopContext(); return false; } @@ -2581,15 +2610,6 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) { return true; } -bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) { - PushContext(x.source, llvm::omp::Directive::OMPD_allocate); - const auto &list{std::get>(x.t)}; - if (list) { - ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective); - } - return true; -} - bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) { const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; PushContext(x.source, dirSpec.DirId()); @@ -2661,10 +2681,6 @@ bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) { return false; } -void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) { - PopContext(); -} - void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) { PopContext(); } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index f88af5fac0bbd..b53bfa5649d44 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1700,12 +1700,12 @@ class OmpVisitor : public virtual DeclarationVisitor { void Post(const parser::OpenMPDeclareTargetConstruct &) { SkipImplicitTyping(false); } - bool Pre(const parser::OpenMPDeclarativeAllocate &x) { + bool Pre(const parser::OmpAllocateDirective &x) { AddOmpSourceRange(x.source); SkipImplicitTyping(true); return true; } - void Post(const parser::OpenMPDeclarativeAllocate &) { + void Post(const parser::OmpAllocateDirective &) { SkipImplicitTyping(false); messageHandler().set_currStmtSource(std::nullopt); } diff --git a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90 b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90 index 8daf20e1ae400..fec146ac70313 100644 --- a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90 +++ b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90 @@ -5,6 +5,6 @@ program main integer :: x - ! CHECK: not yet implemented: OpenMPDeclarativeAllocate + ! CHECK: not yet implemented: OmpAllocateDirective !$omp allocate(x) align(32) end diff --git a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90 b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90 index e83b433d0fda0..3307eb2505b71 100644 --- a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90 +++ b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90 @@ -5,6 +5,6 @@ program main integer :: x, y - ! CHECK: not yet implemented: OpenMPDeclarativeAllocate + ! CHECK: not yet implemented: OmpAllocateDirective !$omp allocate(x, y) end diff --git a/flang/test/Parser/OpenMP/allocate-align-tree.f90 b/flang/test/Parser/OpenMP/allocate-align-tree.f90 index 0d247cd1ed945..d799aa10a82ff 100644 --- a/flang/test/Parser/OpenMP/allocate-align-tree.f90 +++ b/flang/test/Parser/OpenMP/allocate-align-tree.f90 @@ -16,27 +16,33 @@ program allocate_align_tree allocate(j(z), xarray(t)) end program allocate_align_tree -!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt -!CHECK-NEXT: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> -!CHECK-NEXT: | | | AttrSpec -> Allocatable -!CHECK-NEXT: | | | EntityDecl -!CHECK-NEXT: | | | | Name = 'j' +!CHECK: DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt +!CHECK-NEXT: | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> +!CHECK-NEXT: | AttrSpec -> Allocatable +!CHECK-NEXT: | EntityDecl +!CHECK-NEXT: | | Name = 'j' +!CHECK: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | OmpBeginDirective +!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'j' +!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '16_4' +!CHECK-NEXT: | | | LiteralConstant -> IntLiteralConstant = '16' +!CHECK-NEXT: | | Flags = None +!CHECK-NEXT: | Block +!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | OmpBeginDirective +!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray' +!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '32_4' +!CHECK-NEXT: | | | | | LiteralConstant -> IntLiteralConstant = '32' +!CHECK-NEXT: | | | | OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8' +!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc' +!CHECK-NEXT: | | | | Flags = None +!CHECK-NEXT: | | | Block +!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt -!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate -!CHECK-NEXT: | | | Verbatim -!CHECK-NEXT: | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray' -!CHECK-NEXT: | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '32_4' -!CHECK-NEXT: | | | | LiteralConstant -> IntLiteralConstant = '32' -!CHECK-NEXT: | | | OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8' -!CHECK-NEXT: | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc' -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'j' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '16_4' -!CHECK-NEXT: | | | | | LiteralConstant -> IntLiteralConstant = '16' -!CHECK-NEXT: | | | AllocateStmt +!UNPARSE: !$OMP ALLOCATE(j) ALIGN(16_4) +!UNPARSE-NEXT: !$OMP ALLOCATE(xarray) ALIGN(32_4) ALLOCATOR(2_8) +!UNPARSE-NEXT: ALLOCATE(j(z), xarray(t)) -!UNPARSE: !$OMP ALLOCATE (j) ALIGN(16_4) -!UNPARSE: !$OMP ALLOCATE (xarray) ALIGN(32_4) ALLOCATOR(2_8) -!UNPARSE-NEXT: ALLOCATE(j(z), xarray(t)) diff --git a/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90 b/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90 index afcaf44b09f03..800e4a57d5f0e 100644 --- a/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90 +++ b/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90 @@ -17,33 +17,48 @@ program allocate_tree allocate (w, xarray(4), zarray(5, f)) end program allocate_tree -!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | Verbatim -!CHECK-NEXT: | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'f' -!CHECK-NEXT: | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | Designator -> DataRef -> Name = +!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | OmpBeginDirective +!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'f' +!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8' +!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc' +!CHECK-NEXT: | | | | Flags = None +!CHECK-NEXT: | | | Block !CHECK-NEXT: | ExecutionPart -> Block !CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'f=2_4' !CHECK-NEXT: | | | Variable = 'f' !CHECK-NEXT: | | | | Designator -> DataRef -> Name = 'f' !CHECK-NEXT: | | | Expr = '2_4' !CHECK-NEXT: | | | | LiteralConstant -> IntLiteralConstant = '2' -!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate -!CHECK-NEXT: | | | Verbatim -!CHECK-NEXT: | | | OmpClauseList -> -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'w' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | AllocateStmt +!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | OmpBeginDirective +!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'w' +!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '3_8' +!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc' +!CHECK-NEXT: | | | | Flags = None +!CHECK-NEXT: | | | Block +!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | | | OmpBeginDirective +!CHECK-NEXT: | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray' +!CHECK-NEXT: | | | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8' +!CHECK-NEXT: | | | | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc' +!CHECK-NEXT: | | | | | | Flags = None +!CHECK-NEXT: | | | | | Block +!CHECK-NEXT: | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | | | | | OmpBeginDirective +!CHECK-NEXT: | | | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'zarray' +!CHECK-NEXT: | | | | | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8' +!CHECK-NEXT: | | | | | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc' +!CHECK-NEXT: | | | | | | | | Flags = None +!CHECK-NEXT: | | | | | | | Block +!CHECK-NEXT: | | | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | | | | | | | OmpBeginDirective +!CHECK-NEXT: | | | | | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | | | | | | | OmpClauseList -> +!CHECK-NEXT: | | | | | | | | | | Flags = None +!CHECK-NEXT: | | | | | | | | | Block +!CHECK-NEXT: | | | | | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt diff --git a/flang/test/Parser/OpenMP/allocate-tree.f90 b/flang/test/Parser/OpenMP/allocate-tree.f90 index bf413d591baf2..021d8104a7e62 100644 --- a/flang/test/Parser/OpenMP/allocate-tree.f90 +++ b/flang/test/Parser/OpenMP/allocate-tree.f90 @@ -7,52 +7,54 @@ program allocate_tree use omp_lib - integer, allocatable :: w, xarray(:), zarray(:, :) - integer :: z, t + integer, allocatable :: xarray(:), zarray(:, :) + integer :: z, t, w +!$omp allocate(w) allocator(omp_const_mem_alloc) t = 2 z = 3 -!$omp allocate(w) allocator(omp_const_mem_alloc) !$omp allocate(xarray) allocator(omp_large_cap_mem_alloc) !$omp allocate(zarray) allocator(omp_default_mem_alloc) !$omp allocate - allocate(w, xarray(4), zarray(t, z)) + allocate(xarray(4), zarray(t, z)) end program allocate_tree -!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt -!CHECK-NEXT: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec -> -!CHECK-NEXT: | | | AttrSpec -> Allocatable -!CHECK-NEXT: | | | EntityDecl -!CHECK-NEXT: | | | | Name = 'w' -!CHECK-NEXT: | | | EntityDecl -!CHECK-NEXT: | | | | Name = 'xarray' -!CHECK-NEXT: | | | | ArraySpec -> DeferredShapeSpecList -> int = '1' -!CHECK-NEXT: | | | EntityDecl -!CHECK-NEXT: | | | | Name = 'zarray' -!CHECK-NEXT: | | | | ArraySpec -> DeferredShapeSpecList -> int = '2' - +!CHECK: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpAllocateDirective +!CHECK-NEXT: | OmpBeginDirective +!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'w' +!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '3_8' +!CHECK-NEXT: | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc' +!CHECK-NEXT: | | Flags = None +!CHECK-NEXT: | Block -!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate -!CHECK-NEXT: | | | Verbatim -!CHECK-NEXT: | | | OmpClauseList -> -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'w' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | OpenMPDeclarativeAllocate -!CHECK-NEXT: | | | | Verbatim -!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray' -!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = -!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = -!CHECK-NEXT: | | | AllocateStmt +!CHECK: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | OmpBeginDirective +!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray' +!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8' +!CHECK-NEXT: | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc' +!CHECK-NEXT: | | Flags = None +!CHECK-NEXT: | Block +!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | OmpBeginDirective +!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'zarray' +!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8' +!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc' +!CHECK-NEXT: | | | | Flags = None +!CHECK-NEXT: | | | Block +!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective +!CHECK-NEXT: | | | | | OmpBeginDirective +!CHECK-NEXT: | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate +!CHECK-NEXT: | | | | | | OmpClauseList -> +!CHECK-NEXT: | | | | | | Flags = None +!CHECK-NEXT: | | | | | Block +!CHECK-NEXT: | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt -!UNPARSE: !$OMP ALLOCATE (w) ALLOCATOR(3_8) -!UNPARSE-NEXT: !$OMP ALLOCATE (xarray) ALLOCATOR(2_8) -!UNPARSE-NEXT: !$OMP ALLOCATE (zarray) ALLOCATOR(1_8) +!UNPARSE: !$OMP ALLOCATE(w) ALLOCATOR(3_8) +!UNPARSE-NEXT: t=2_4 +!UNPARSE-NEXT: z=3_4 +!UNPARSE-NEXT: !$OMP ALLOCATE(xarray) ALLOCATOR(2_8) +!UNPARSE-NEXT: !$OMP ALLOCATE(zarray) ALLOCATOR(1_8) !UNPARSE-NEXT: !$OMP ALLOCATE -!UNPARSE-NEXT: ALLOCATE(w, xarray(4_4), zarray(t,z)) +!UNPARSE-NEXT: ALLOCATE(xarray(4_4), zarray(t,z)) diff --git a/flang/test/Parser/OpenMP/allocate-unparse.f90 b/flang/test/Parser/OpenMP/allocate-unparse.f90 index 94bc2adf35ea9..2935613e84e47 100644 --- a/flang/test/Parser/OpenMP/allocate-unparse.f90 +++ b/flang/test/Parser/OpenMP/allocate-unparse.f90 @@ -30,17 +30,17 @@ program allocate_unparse end program allocate_unparse -!CHECK:!$OMP ALLOCATE (x,y) -!CHECK:!$OMP ALLOCATE (x,y) ALLOCATOR(omp_default_mem_alloc) -!CHECK:!$OMP ALLOCATE (a,b) +!CHECK:!$OMP ALLOCATE(x, y) +!CHECK:!$OMP ALLOCATE(x, y) ALLOCATOR(omp_default_mem_alloc) +!CHECK:!$OMP ALLOCATE(a, b) !CHECK:ALLOCATE(darray(a,b)) !CHECK:!$OMP ALLOCATE ALLOCATOR(omp_default_mem_alloc) !CHECK:ALLOCATE(darray(a,b)) -!CHECK:!$OMP ALLOCATE (a,b) ALLOCATOR(omp_default_mem_alloc) +!CHECK:!$OMP ALLOCATE(a, b) ALLOCATOR(omp_default_mem_alloc) !CHECK:ALLOCATE(darray(a,b)) -!CHECK:!$OMP ALLOCATE (t) ALLOCATOR(omp_const_mem_alloc) -!CHECK:!$OMP ALLOCATE (z) ALLOCATOR(omp_default_mem_alloc) -!CHECK:!$OMP ALLOCATE (m) ALLOCATOR(omp_default_mem_alloc) -!CHECK:!$OMP ALLOCATE (n) -!CHECK:!$OMP ALLOCATE (j) ALIGN(16) +!CHECK:!$OMP ALLOCATE(t) ALLOCATOR(omp_const_mem_alloc) +!CHECK:!$OMP ALLOCATE(z) ALLOCATOR(omp_default_mem_alloc) +!CHECK:!$OMP ALLOCATE(m) ALLOCATOR(omp_default_mem_alloc) +!CHECK:!$OMP ALLOCATE(n) +!CHECK:!$OMP ALLOCATE(j) ALIGN(16) !CHECK:ALLOCATE(darray(z,t)) diff --git a/flang/test/Semantics/OpenMP/allocate-align01.f90 b/flang/test/Semantics/OpenMP/allocate-align01.f90 index 88bcd6d2f1008..4a1e60cf73fff 100644 --- a/flang/test/Semantics/OpenMP/allocate-align01.f90 +++ b/flang/test/Semantics/OpenMP/allocate-align01.f90 @@ -11,9 +11,9 @@ program allocate_align_tree integer :: z, t, xx t = 2 z = 3 + !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage] !ERROR: Must be a constant value !$omp allocate(j) align(xx) - !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage] !ERROR: The alignment should be positive !$omp allocate(xarray) align(-32) allocator(omp_large_cap_mem_alloc) allocate(j(z), xarray(t)) diff --git a/flang/test/Semantics/OpenMP/allocate-directive.f90 b/flang/test/Semantics/OpenMP/allocate-directive.f90 index 18a14b825f00d..e34125b392bda 100644 --- a/flang/test/Semantics/OpenMP/allocate-directive.f90 +++ b/flang/test/Semantics/OpenMP/allocate-directive.f90 @@ -11,7 +11,7 @@ integer, allocatable :: a, b, m, n, t, z !$omp allocate(x, y) !$omp allocate(x, y) allocator(omp_default_mem_alloc) - + continue !$omp allocate(a, b) allocate ( a, b ) diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90 index 229fd4d6c3f95..5fe4efdd106d9 100644 --- a/flang/test/Semantics/OpenMP/allocate01.f90 +++ b/flang/test/Semantics/OpenMP/allocate01.f90 @@ -17,7 +17,7 @@ subroutine sema() !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 + print *, a !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage] !$omp allocate(x) allocator(omp_default_mem_alloc) diff --git a/flang/test/Semantics/OpenMP/allocate02.f90 b/flang/test/Semantics/OpenMP/allocate02.f90 index 8f0579e810bb9..a1e684796edb2 100644 --- a/flang/test/Semantics/OpenMP/allocate02.f90 +++ b/flang/test/Semantics/OpenMP/allocate02.f90 @@ -16,6 +16,7 @@ subroutine allocate() !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive !$omp allocate(x, y) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc) + continue !$omp allocate(darray) allocator(omp_default_mem_alloc) allocate ( darray(a, b) ) diff --git a/flang/test/Semantics/OpenMP/allocate03.f90 b/flang/test/Semantics/OpenMP/allocate03.f90 index e35115f3897cc..3609f38eb6ee7 100644 --- a/flang/test/Semantics/OpenMP/allocate03.f90 +++ b/flang/test/Semantics/OpenMP/allocate03.f90 @@ -17,6 +17,7 @@ subroutine allocate() !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the ALLOCATE directive !$omp allocate(my_var%array) + continue !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the ALLOCATE directive !$omp allocate(darray, my_var%array) allocator(omp_default_mem_alloc) diff --git a/flang/test/Semantics/OpenMP/allocate06.f90 b/flang/test/Semantics/OpenMP/allocate06.f90 index 9b57322bbadc6..272094aaaeec2 100644 --- a/flang/test/Semantics/OpenMP/allocate06.f90 +++ b/flang/test/Semantics/OpenMP/allocate06.f90 @@ -13,7 +13,7 @@ subroutine allocate() !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute !$omp allocate(darray) allocator(omp_default_mem_alloc) - + continue !$omp allocate(darray) allocator(omp_default_mem_alloc) allocate(darray(a, b)) diff --git a/flang/test/Semantics/OpenMP/allocate10.f90 b/flang/test/Semantics/OpenMP/allocate10.f90 index a9db7330296ba..0a9e85b8ae2fe 100644 --- a/flang/test/Semantics/OpenMP/allocate10.f90 +++ b/flang/test/Semantics/OpenMP/allocate10.f90 @@ -4,8 +4,8 @@ subroutine f00 integer, allocatable :: x, y continue - !ERROR: If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items !$omp allocate + !ERROR: If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items !$omp allocate allocate(x, y) end diff --git a/flang/test/Semantics/OpenMP/allocate12.f90 b/flang/test/Semantics/OpenMP/allocate12.f90 new file mode 100644 index 0000000000000..2b3b510fbf40c --- /dev/null +++ b/flang/test/Semantics/OpenMP/allocate12.f90 @@ -0,0 +1,16 @@ +!RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51 + +subroutine f00 + integer, allocatable :: x + continue + !ERROR: An executable ALLOCATE directive must be associated with an ALLOCATE statement + !$omp allocate(x) +end + +subroutine f01 + integer, allocatable :: x + continue + !$omp allocate(x) + !ERROR: The statement associated with executable ALLOCATE directive must be an ALLOCATE statement + continue +end From beb297ded9c38631b1f0b9461e90081967f87a6f Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Fri, 31 Oct 2025 09:04:11 -0500 Subject: [PATCH 4/7] format --- flang/lib/Lower/OpenMP/OpenMP.cpp | 8 ++++---- flang/lib/Semantics/canonicalize-omp.cpp | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index b901f24ae366e..ad456d89bc432 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -3503,10 +3503,10 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, lower::pft::Evaluation &eval, const parser::OpenMPUtilityConstruct &); -static void -genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, - semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval, - const parser::OmpAllocateDirective &allocate) { +static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable, + semantics::SemanticsContext &semaCtx, + lower::pft::Evaluation &eval, + const parser::OmpAllocateDirective &allocate) { if (!semaCtx.langOptions().OpenMPSimd) TODO(converter.getCurrentLocation(), "OmpAllocateDirective"); } diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp index 039dd7f564758..77ca872ba5f49 100644 --- a/flang/lib/Semantics/canonicalize-omp.cpp +++ b/flang/lib/Semantics/canonicalize-omp.cpp @@ -294,8 +294,8 @@ class CanonicalizationOfOmp { } } - parser::ExecutionPartConstruct EmbedInExec(parser::OmpAllocateDirective *alo, - parser::ExecutionPartConstruct &&epc) { + parser::ExecutionPartConstruct EmbedInExec( + parser::OmpAllocateDirective *alo, parser::ExecutionPartConstruct &&epc) { // Nest current epc inside the allocate directive. std::get(alo->t).push_front(std::move(epc)); // Set the new epc to be the ExecutionPartConstruct made from From 3a1d252128817fe120be457d3363526844692bbe Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Fri, 31 Oct 2025 10:55:30 -0500 Subject: [PATCH 5/7] Fix unparsing empty object list --- flang/lib/Parser/unparse.cpp | 4 +--- flang/test/Parser/OpenMP/allocate-unparse.f90 | 6 ++++++ 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index b3a395c4d72e1..9255c4e1136bc 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2502,9 +2502,7 @@ class UnparseVisitor { void Unparse(const OpenMPDeclarativeAllocate &x) { BeginOpenMP(); Word("!$OMP ALLOCATE"); - Put(" ("); - Walk(std::get>(x.t)); - Put(")"); + Walk(" (", std::get>(x.t), ")"); Walk(std::get(x.t)); Put("\n"); EndOpenMP(); diff --git a/flang/test/Parser/OpenMP/allocate-unparse.f90 b/flang/test/Parser/OpenMP/allocate-unparse.f90 index 94bc2adf35ea9..63cc35cd55082 100644 --- a/flang/test/Parser/OpenMP/allocate-unparse.f90 +++ b/flang/test/Parser/OpenMP/allocate-unparse.f90 @@ -9,6 +9,7 @@ program allocate_unparse ! 2.11.3 declarative allocate +!$omp allocate !$omp allocate(x, y) !$omp allocate(x, y) allocator(omp_default_mem_alloc) @@ -28,8 +29,11 @@ program allocate_unparse !$omp allocate(j) align(16) allocate ( darray(z, t) ) +!$omp allocate + allocate ( darray(a, b) ) end program allocate_unparse +!CHECK:!$OMP ALLOCATE{{[ ]*$}} !CHECK:!$OMP ALLOCATE (x,y) !CHECK:!$OMP ALLOCATE (x,y) ALLOCATOR(omp_default_mem_alloc) !CHECK:!$OMP ALLOCATE (a,b) @@ -44,3 +48,5 @@ end program allocate_unparse !CHECK:!$OMP ALLOCATE (n) !CHECK:!$OMP ALLOCATE (j) ALIGN(16) !CHECK:ALLOCATE(darray(z,t)) +!CHECK:!$OMP ALLOCATE{{[ ]*$}} +!CHECK:ALLOCATE(darray(a,b)) From fc66fb6325e1b15fdea16ab1add5b96af852d425 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Fri, 31 Oct 2025 12:00:14 -0500 Subject: [PATCH 6/7] review feedback --- flang/lib/Semantics/canonicalize-omp.cpp | 2 +- flang/lib/Semantics/check-omp-structure.cpp | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp index 77ca872ba5f49..a11c5250b1ab4 100644 --- a/flang/lib/Semantics/canonicalize-omp.cpp +++ b/flang/lib/Semantics/canonicalize-omp.cpp @@ -280,7 +280,7 @@ class CanonicalizationOfOmp { // show up in the tuple in specification part: // (1) in std::list, or // (2) in std::list. - // The case (1) is only possible is the list (2) is empty. + // The case (1) is only possible if the list (2) is empty. auto &omps = std::get>(spec.t); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 40d574a481582..e7e3f4d886b34 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1841,7 +1841,7 @@ void OmpStructureChecker::CheckExecutableAllocateDirective( for (const parser::OmpArgument &arg : spec.Arguments().v) { if (auto *sym{GetArgumentSymbol(arg)}) { // Ignore these checks for structure members. They are not allowed - // in the first place, so don't tell the users that they nened to + // in the first place, so don't tell the users that they need to // be specified somewhere, if (IsStructureComponent(*sym)) { continue; @@ -2225,7 +2225,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) { } void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { - const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; const parser::OmpDirectiveName &dirName{beginSpec.DirName()}; PushContextAndClauseSets( From c6b9d1b887933c5fa2830678242fdd43d560147c Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Mon, 3 Nov 2025 07:18:05 -0600 Subject: [PATCH 7/7] fix merge error --- flang/lib/Semantics/check-omp-structure.cpp | 72 --------------------- 1 file changed, 72 deletions(-) diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 661eb69170dc4..e7e3f4d886b34 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -2251,78 +2251,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { } } } -} - -void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { - auto [allocStmt, allocSource]{getAllocateStmtAndSource( - std::get>(x.t))}; - - UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)}; - SymbolSourceMap directiveSyms; - auto &objects{ - GetObjectsOrEmpty(std::get>(x.t))}; - auto emptyListCount{static_cast(objects.v.empty())}; - auto checkObjects{[&](const parser::OmpObjectList &objects, - parser::CharBlock dirSource, - parser::CharBlock allocSource) { - for (const parser::OmpObject &object : objects.v) { - parser::CharBlock objSource{[&]() { - if (auto &&maybeSource{GetObjectSource(object)}) { - return *maybeSource; - } - return dirSource; - }()}; - if (auto *sym{GetObjectSymbol(object)}) { - // Ignore these checks for structure members. They are not allowed - // in the first place, so don't tell the users that they nened to - // be specified somewhere, - if (IsStructureComponent(*sym)) { - continue; - } - if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) { - parser::MessageFormattedText txt( - "A list item on an executable ALLOCATE may only be specified once"_err_en_US); - parser::Message message(objSource, txt); - message.Attach(f->second, "The list item was specified here"_en_US); - context_.Say(std::move(message)); - } else { - directiveSyms.insert(std::make_pair(sym, objSource)); - } - - if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) { - context_ - .Say(objSource, - "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US) - .Attach(allocSource, "The ALLOCATE statement"_en_US); - } - } - } - }}; - - checkObjects(objects, std::get(x.t).source, allocSource); - - const auto &subDirs{ - std::get>>( - x.t)}; - if (!subDirs) { - inExecutableAllocate_ = false; - dirContext_.pop_back(); - return; - } - - for (const parser::OpenMPDeclarativeAllocate &ompAlloc : *subDirs) { - parser::CharBlock dirSource{std::get(ompAlloc.t).source}; - auto &objects{GetObjectsOrEmpty( - std::get>(ompAlloc.t))}; - if (objects.v.empty()) { - // Only show the message once per construct. - if (++emptyListCount == 2 && subDirs->size() >= 1) { - context_.Say(dirSource, - "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US); - } - } - checkObjects(objects, dirSource, allocSource); - } auto &body{std::get(x.t)}; // The parser should put at most one statement in the body.