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..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/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index aaaf1ec5d4626..3ea8e5b8cd2b0 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,170 @@ 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); + 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/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)) 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