diff options
Diffstat (limited to 'flang/lib/Semantics')
20 files changed, 870 insertions, 571 deletions
diff --git a/flang/lib/Semantics/canonicalize-directives.cpp b/flang/lib/Semantics/canonicalize-directives.cpp index a651a87..f32a3d3 100644 --- a/flang/lib/Semantics/canonicalize-directives.cpp +++ b/flang/lib/Semantics/canonicalize-directives.cpp @@ -56,6 +56,7 @@ bool CanonicalizeDirectives( static bool IsExecutionDirective(const parser::CompilerDirective &dir) { return std::holds_alternative<parser::CompilerDirective::VectorAlways>( dir.u) || + std::holds_alternative<parser::CompilerDirective::VectorLength>(dir.u) || std::holds_alternative<parser::CompilerDirective::Unroll>(dir.u) || std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(dir.u) || std::holds_alternative<parser::CompilerDirective::NoVector>(dir.u) || @@ -64,7 +65,8 @@ static bool IsExecutionDirective(const parser::CompilerDirective &dir) { dir.u) || std::holds_alternative<parser::CompilerDirective::ForceInline>(dir.u) || std::holds_alternative<parser::CompilerDirective::Inline>(dir.u) || - std::holds_alternative<parser::CompilerDirective::NoInline>(dir.u); + std::holds_alternative<parser::CompilerDirective::NoInline>(dir.u) || + std::holds_alternative<parser::CompilerDirective::IVDep>(dir.u); } void CanonicalizationOfDirectives::Post(parser::SpecificationPart &spec) { @@ -120,6 +122,9 @@ void CanonicalizationOfDirectives::Post(parser::Block &block) { common::visitors{[&](parser::CompilerDirective::VectorAlways &) { CheckLoopDirective(*dir, block, it); }, + [&](parser::CompilerDirective::VectorLength &) { + CheckLoopDirective(*dir, block, it); + }, [&](parser::CompilerDirective::Unroll &) { CheckLoopDirective(*dir, block, it); }, @@ -135,6 +140,9 @@ void CanonicalizationOfDirectives::Post(parser::Block &block) { [&](parser::CompilerDirective::NoUnrollAndJam &) { CheckLoopDirective(*dir, block, it); }, + [&](parser::CompilerDirective::IVDep &) { + CheckLoopDirective(*dir, block, it); + }, [&](auto &) {}}, dir->u); } diff --git a/flang/lib/Semantics/canonicalize-do.cpp b/flang/lib/Semantics/canonicalize-do.cpp index ef20cff..8b23f88 100644 --- a/flang/lib/Semantics/canonicalize-do.cpp +++ b/flang/lib/Semantics/canonicalize-do.cpp @@ -7,7 +7,9 @@ //===----------------------------------------------------------------------===// #include "canonicalize-do.h" +#include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree-visitor.h" +#include "flang/Parser/tools.h" namespace Fortran::parser { @@ -87,6 +89,16 @@ public: [&](Statement<ActionStmt> &actionStmt) { CanonicalizeIfMatch(block, stack, i, actionStmt); }, + [&](common::Indirection<OpenMPConstruct> &construct) { + // If the body of the OpenMP construct ends with a label, + // treat the label as ending the construct itself. + OpenMPConstruct &omp{construct.value()}; + if (CanonicalizeIfMatch( + block, stack, i, omp::GetFinalLabel(omp))) { + MarkOpenMPConstruct( + omp, OmpDirectiveSpecification::Flag::CrossesLabelDo); + } + }, }, executableConstruct->u); } @@ -95,12 +107,16 @@ public: private: template <typename T> - void CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack, + bool CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack, Block::iterator &i, Statement<T> &statement) { - if (!stack.empty() && statement.label && - stack.back().label == *statement.label) { + return CanonicalizeIfMatch(originalBlock, stack, i, statement.label); + } + + bool CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack, + Block::iterator &i, std::optional<Label> label) { + if (!stack.empty() && label && stack.back().label == *label) { auto currentLabel{stack.back().label}; - if constexpr (std::is_same_v<T, common::Indirection<EndDoStmt>>) { + if (Unwrap<EndDoStmt>(*i)) { std::get<ExecutableConstruct>(i->u).u = Statement<ActionStmt>{ std::optional<Label>{currentLabel}, ContinueStmt{}}; } @@ -129,8 +145,27 @@ private: stack.pop_back(); } while (!stack.empty() && stack.back().label == currentLabel); i = --next; + return true; + } else { + return false; } } + + void MarkOpenMPConstruct( + OpenMPConstruct &omp, OmpDirectiveSpecification::Flag flag) { + common::visit( + [&](const auto &s) { + using S = std::decay_t<decltype(s)>; + if constexpr (std::is_base_of_v<OmpBlockConstruct, S> || + std::is_same_v<OpenMPLoopConstruct, S>) { + const OmpDirectiveSpecification &beginSpec{s.BeginDir()}; + auto &flags{ + std::get<OmpDirectiveSpecification::Flags>(beginSpec.t)}; + const_cast<OmpDirectiveSpecification::Flags &>(flags).set(flag); + } + }, + omp.u); + } }; bool CanonicalizeDo(Program &program) { diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp index a11c525..802b2ac 100644 --- a/flang/lib/Semantics/canonicalize-omp.cpp +++ b/flang/lib/Semantics/canonicalize-omp.cpp @@ -9,6 +9,7 @@ #include "canonicalize-omp.h" #include "flang/Parser/parse-tree-visitor.h" #include "flang/Parser/parse-tree.h" +#include "flang/Semantics/openmp-directive-sets.h" #include "flang/Semantics/semantics.h" // After Loop Canonicalization, rewrite OpenMP parse tree to make OpenMP @@ -31,26 +32,6 @@ public: CanonicalizationOfOmp(SemanticsContext &context) : context_{context}, messages_{context.messages()} {} - void Post(parser::Block &block) { - for (auto it{block.begin()}; it != block.end(); ++it) { - if (auto *ompCons{GetConstructIf<parser::OpenMPConstruct>(*it)}) { - // OpenMPLoopConstruct - if (auto *ompLoop{ - std::get_if<parser::OpenMPLoopConstruct>(&ompCons->u)}) { - RewriteOpenMPLoopConstruct(*ompLoop, block, it); - } - } else if (auto *endDir{ - GetConstructIf<parser::OmpEndLoopDirective>(*it)}) { - // Unmatched OmpEndLoopDirective - const parser::OmpDirectiveName &endName{endDir->DirName()}; - messages_.Say(endName.source, - "The %s directive must follow the DO loop associated with the " - "loop construct"_err_en_US, - parser::ToUpperCaseLetters(endName.source.ToString())); - } - } // Block list - } - // 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) { @@ -92,152 +73,6 @@ public: void Post(parser::OmpMapClause &map) { CanonicalizeMapModifiers(map); } private: - template <typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) { - if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) { - if (auto *z{std::get_if<common::Indirection<T>>(&y->u)}) { - return &z->value(); - } - } - return nullptr; - } - - template <typename T> T *GetOmpIf(parser::ExecutionPartConstruct &x) { - if (auto *construct{GetConstructIf<parser::OpenMPConstruct>(x)}) { - if (auto *omp{std::get_if<T>(&construct->u)}) { - return omp; - } - } - return nullptr; - } - - void RewriteOpenMPLoopConstruct(parser::OpenMPLoopConstruct &x, - parser::Block &block, parser::Block::iterator it) { - // Check the sequence of DoConstruct and OmpEndLoopDirective - // in the same iteration - // - // Original: - // ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct - // OmpBeginLoopDirective - // ExecutableConstruct -> DoConstruct - // ExecutableConstruct -> OmpEndLoopDirective (if available) - // - // After rewriting: - // ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct - // OmpBeginLoopDirective - // DoConstruct - // OmpEndLoopDirective (if available) - parser::Block::iterator nextIt; - const parser::OmpDirectiveSpecification &beginDir{x.BeginDir()}; - const parser::OmpDirectiveName &beginName{beginDir.DirName()}; - - auto missingDoConstruct = [](const parser::OmpDirectiveName &dirName, - parser::Messages &messages) { - messages.Say(dirName.source, - "A DO loop must follow the %s directive"_err_en_US, - parser::ToUpperCaseLetters(dirName.source.ToString())); - }; - auto tileUnrollError = [](const parser::OmpDirectiveName &dirName, - parser::Messages &messages) { - messages.Say(dirName.source, - "If a loop construct has been fully unrolled, it cannot then be tiled"_err_en_US, - parser::ToUpperCaseLetters(dirName.source.ToString())); - }; - - nextIt = it; - while (++nextIt != block.end()) { - // Ignore compiler directives. - if (GetConstructIf<parser::CompilerDirective>(*nextIt)) - continue; - - if (auto *doCons{GetConstructIf<parser::DoConstruct>(*nextIt)}) { - if (doCons->GetLoopControl()) { - // move DoConstruct - std::get<std::optional<std::variant<parser::DoConstruct, - common::Indirection<parser::OpenMPLoopConstruct>>>>(x.t) = - std::move(*doCons); - nextIt = block.erase(nextIt); - // try to match OmpEndLoopDirective - if (nextIt != block.end()) { - if (auto *endDir{ - GetConstructIf<parser::OmpEndLoopDirective>(*nextIt)}) { - std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) = - std::move(*endDir); - nextIt = block.erase(nextIt); - } - } - } else { - messages_.Say(beginName.source, - "DO loop after the %s directive must have loop control"_err_en_US, - parser::ToUpperCaseLetters(beginName.source.ToString())); - } - } else if (auto *ompLoopCons{ - GetOmpIf<parser::OpenMPLoopConstruct>(*nextIt)}) { - // We should allow UNROLL and TILE constructs to be inserted between an - // OpenMP Loop Construct and the DO loop itself - auto &nestedBeginDirective = ompLoopCons->BeginDir(); - auto &nestedBeginName = nestedBeginDirective.DirName(); - if ((nestedBeginName.v == llvm::omp::Directive::OMPD_unroll || - nestedBeginName.v == llvm::omp::Directive::OMPD_tile) && - !(nestedBeginName.v == llvm::omp::Directive::OMPD_unroll && - beginName.v == llvm::omp::Directive::OMPD_tile)) { - // iterate through the remaining block items to find the end directive - // for the unroll/tile directive. - parser::Block::iterator endIt; - endIt = nextIt; - while (endIt != block.end()) { - if (auto *endDir{ - GetConstructIf<parser::OmpEndLoopDirective>(*endIt)}) { - auto &endDirName = endDir->DirName(); - if (endDirName.v == beginName.v) { - std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) = - std::move(*endDir); - endIt = block.erase(endIt); - continue; - } - } - ++endIt; - } - RewriteOpenMPLoopConstruct(*ompLoopCons, block, nextIt); - auto &ompLoop = std::get<std::optional<parser::NestedConstruct>>(x.t); - ompLoop = - std::optional<parser::NestedConstruct>{parser::NestedConstruct{ - common::Indirection{std::move(*ompLoopCons)}}}; - nextIt = block.erase(nextIt); - } else if (nestedBeginName.v == llvm::omp::Directive::OMPD_unroll && - beginName.v == llvm::omp::Directive::OMPD_tile) { - // if a loop has been unrolled, the user can not then tile that loop - // as it has been unrolled - const parser::OmpClauseList &unrollClauseList{ - nestedBeginDirective.Clauses()}; - if (unrollClauseList.v.empty()) { - // if the clause list is empty for an unroll construct, we assume - // the loop is being fully unrolled - tileUnrollError(beginName, messages_); - } else { - // parse the clauses for the unroll directive to find the full - // clause - for (auto &clause : unrollClauseList.v) { - if (clause.Id() == llvm::omp::OMPC_full) { - tileUnrollError(beginName, messages_); - } - } - } - } else { - messages_.Say(nestedBeginName.source, - "Only Loop Transformation Constructs or Loop Nests can be nested within Loop Constructs"_err_en_US, - parser::ToUpperCaseLetters(nestedBeginName.source.ToString())); - } - } else { - missingDoConstruct(beginName, messages_); - } - // If we get here, we either found a loop, or issued an error message. - return; - } - if (nextIt == block.end()) { - missingDoConstruct(beginName, messages_); - } - } - // Canonicalization of allocate directives // // In OpenMP 5.0 and 5.1 the allocate directive could either be a declarative diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 995deaa..022b428 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -548,8 +548,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, actualLastSymbol = &ResolveAssociations(*actualLastSymbol); } int actualRank{actualType.Rank()}; - if (dummy.type.attrs().test( - characteristics::TypeAndShape::Attr::AssumedShape)) { + if (dummyIsValue && dummyRank == 0 && + dummy.ignoreTKR.test(common::IgnoreTKR::Rank) && actualRank > 0) { + messages.Say( + "Array actual argument may not be associated with IGNORE_TKR(R) scalar %s with VALUE attribute"_err_en_US, + dummyName); + } else if (dummy.type.attrs().test( + characteristics::TypeAndShape::Attr::AssumedShape)) { // 15.5.2.4(16) if (actualIsAssumedRank) { messages.Say( @@ -795,7 +800,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, bool dummyIsAssumedShape{dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape)}; bool copyOutNeeded{ - evaluate::MayNeedCopy(&arg, &dummyArg, foldingContext, true)}; + evaluate::ActualArgNeedsCopy(&arg, &dummyArg, foldingContext, + /*forCopyOut=*/true) + .value_or(false)}; if (copyOutNeeded && !dummyIsValue && (dummyIsAsynchronous || dummyIsVolatile)) { if (actualIsAsynchronous || actualIsVolatile) { @@ -832,8 +839,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // a unread value in the actual argument. // Occurences of `volatileOrAsyncNeedsTempDiagnosticIssued = true` indicate a // more specific error message has already been issued. We might be able to - // clean this up by switching the coding style of MayNeedCopy to be more like - // WhyNotDefinable. + // clean this up by switching the coding style of ActualArgNeedsCopy to be + // more like WhyNotDefinable. if (copyOutNeeded && !volatileOrAsyncNeedsTempDiagnosticIssued) { if ((actualIsVolatile || actualIsAsynchronous) && (dummyIsVolatile || dummyIsAsynchronous)) { diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index de407d3..9a6b3ff 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -855,6 +855,15 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "Variable '%s' with EVENT_TYPE or LOCK_TYPE potential component '%s' must be a coarray"_err_en_US, symbol.name(), component.BuildResultDesignatorName()); + } else if (IsNotifyType(derived)) { // C1612 + messages_.Say( + "Variable '%s' with NOTIFY_TYPE must be a coarray"_err_en_US, + symbol.name()); + } else if (auto component{FindNotifyPotentialComponent( // C1611 + *derived, /*ignoreCoarrays=*/true)}) { + messages_.Say( + "Variable '%s' with NOTIFY_TYPE potential component '%s' must be a coarray"_err_en_US, + symbol.name(), component.BuildResultDesignatorName()); } } } @@ -873,6 +882,10 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US); } + if (IsOrContainsNotifyComponent(symbol)) { // C1613 + messages_.Say( + "An INTENT(OUT) dummy argument may not be, or contain, NOTIFY_TYPE"_err_en_US); + } if (IsAssumedSizeArray(symbol)) { // C834 if (type && type->IsPolymorphic()) { messages_.Say( diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp index 2707921..b9e34ca 100644 --- a/flang/lib/Semantics/check-omp-atomic.cpp +++ b/flang/lib/Semantics/check-omp-atomic.cpp @@ -19,6 +19,7 @@ #include "flang/Evaluate/rewrite.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/char-block.h" +#include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/symbol.h" @@ -41,6 +42,7 @@ namespace Fortran::semantics { +using namespace Fortran::parser::omp; using namespace Fortran::semantics::omp; namespace operation = Fortran::evaluate::operation; @@ -590,9 +592,11 @@ void OmpStructureChecker::CheckAtomicVariable( CheckAtomicType(syms.back(), source, atom.AsFortran(), checkTypeOnPointer); - if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) { - context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US, - atom.AsFortran()); + if (!IsArrayElement(atom) && !ExtractComplexPart(atom)) { + if (IsAllocatable(syms.back())) { + context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US, + atom.AsFortran()); + } } } diff --git a/flang/lib/Semantics/check-omp-loop.cpp b/flang/lib/Semantics/check-omp-loop.cpp index aaaa2d6..726dbe8 100644 --- a/flang/lib/Semantics/check-omp-loop.cpp +++ b/flang/lib/Semantics/check-omp-loop.cpp @@ -245,6 +245,98 @@ void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) { } } +static bool IsLoopTransforming(llvm::omp::Directive dir) { + switch (dir) { + // TODO case llvm::omp::Directive::OMPD_flatten: + case llvm::omp::Directive::OMPD_fuse: + case llvm::omp::Directive::OMPD_interchange: + case llvm::omp::Directive::OMPD_nothing: + case llvm::omp::Directive::OMPD_reverse: + // TODO case llvm::omp::Directive::OMPD_split: + case llvm::omp::Directive::OMPD_stripe: + case llvm::omp::Directive::OMPD_tile: + case llvm::omp::Directive::OMPD_unroll: + return true; + default: + return false; + } +} + +void OmpStructureChecker::CheckNestedBlock(const parser::OpenMPLoopConstruct &x, + const parser::Block &body, size_t &nestedCount) { + for (auto &stmt : body) { + if (auto *dir{parser::Unwrap<parser::CompilerDirective>(stmt)}) { + context_.Say(dir->source, + "Compiler directives are not allowed inside OpenMP loop constructs"_warn_en_US); + } else if (parser::Unwrap<parser::DoConstruct>(stmt)) { + ++nestedCount; + } else if (auto *omp{parser::Unwrap<parser::OpenMPLoopConstruct>(stmt)}) { + if (!IsLoopTransforming(omp->BeginDir().DirId())) { + context_.Say(omp->source, + "Only loop-transforming OpenMP constructs are allowed inside OpenMP loop constructs"_err_en_US); + } + ++nestedCount; + } else if (auto *block{parser::Unwrap<parser::BlockConstruct>(stmt)}) { + CheckNestedBlock(x, std::get<parser::Block>(block->t), nestedCount); + } else { + parser::CharBlock source{parser::GetSource(stmt).value_or(x.source)}; + context_.Say(source, + "OpenMP loop construct can only contain DO loops or loop-nest-generating OpenMP constructs"_err_en_US); + } + } +} + +void OmpStructureChecker::CheckNestedConstruct( + const parser::OpenMPLoopConstruct &x) { + size_t nestedCount{0}; + + // End-directive is not allowed in such cases: + // do 100 i = ... + // !$omp do + // do 100 j = ... + // 100 continue + // !$omp end do ! error + const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()}; + auto &flags{std::get<parser::OmpDirectiveSpecification::Flags>(beginSpec.t)}; + if (flags.test(parser::OmpDirectiveSpecification::Flag::CrossesLabelDo)) { + if (auto &endSpec{x.EndDir()}) { + parser::CharBlock beginSource{beginSpec.DirName().source}; + context_ + .Say(endSpec->DirName().source, + "END %s directive is not allowed when the construct does not contain all loops that share a loop-terminating statement"_err_en_US, + parser::ToUpperCaseLetters(beginSource.ToString())) + .Attach(beginSource, "The construct starts here"_en_US); + } + } + + auto &body{std::get<parser::Block>(x.t)}; + if (body.empty()) { + context_.Say(x.source, + "OpenMP loop construct should contain a DO-loop or a loop-nest-generating OpenMP construct"_err_en_US); + } else { + CheckNestedBlock(x, body, nestedCount); + } +} + +void OmpStructureChecker::CheckFullUnroll( + const parser::OpenMPLoopConstruct &x) { + // If the nested construct is a full unroll, then this construct is invalid + // since it won't contain a loop. + if (const parser::OpenMPLoopConstruct *nested{x.GetNestedConstruct()}) { + auto &nestedSpec{nested->BeginDir()}; + if (nestedSpec.DirId() == llvm::omp::Directive::OMPD_unroll) { + bool isPartial{ + llvm::any_of(nestedSpec.Clauses().v, [](const parser::OmpClause &c) { + return c.Id() == llvm::omp::Clause::OMPC_partial; + })}; + if (!isPartial) { + context_.Say(x.source, + "OpenMP loop construct cannot apply to a fully unrolled loop"_err_en_US); + } + } + } +} + void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { loopStack_.push_back(&x); @@ -262,6 +354,15 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { EnterDirectiveNest(SIMDNest); } + if (CurrentDirectiveIsNested() && + llvm::omp::topTeamsSet.test(GetContext().directive) && + GetContextParent().directive == llvm::omp::Directive::OMPD_target && + !GetDirectiveNest(TargetBlockOnlyTeams)) { + context_.Say(GetContextParent().directiveSource, + "TARGET construct with nested TEAMS region contains statements or " + "directives outside of the TEAMS construct"_err_en_US); + } + // Combined target loop constructs are target device constructs. Keep track of // whether any such construct has been visited to later check that REQUIRES // directives for target-related options don't appear after them. @@ -285,15 +386,15 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { } SetLoopInfo(x); - auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t); - if (optLoopCons.has_value()) { - if (const auto &doConstruct{ - std::get_if<parser::DoConstruct>(&*optLoopCons)}) { + for (auto &construct : std::get<parser::Block>(x.t)) { + if (const auto *doConstruct{parser::omp::GetDoConstruct(construct)}) { const auto &doBlock{std::get<parser::Block>(doConstruct->t)}; CheckNoBranching(doBlock, beginName.v, beginName.source); } } CheckLoopItrVariableIsInt(x); + CheckNestedConstruct(x); + CheckFullUnroll(x); CheckAssociatedLoopConstraints(x); HasInvalidDistributeNesting(x); HasInvalidLoopBinding(x); @@ -305,6 +406,11 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) { beginName.v == llvm::omp::Directive::OMPD_distribute_simd) { CheckDistLinear(x); } + if (beginName.v == llvm::omp::Directive::OMPD_fuse) { + CheckLooprangeBounds(x); + } else { + CheckNestedFuse(x); + } } const parser::Name OmpStructureChecker::GetLoopIndex( @@ -314,45 +420,37 @@ const parser::Name OmpStructureChecker::GetLoopIndex( } void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) { - auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if<parser::DoConstruct>(&*optLoopCons)}) { - const parser::DoConstruct *loop{&*loopConstruct}; - if (loop && loop->IsDoNormal()) { - const parser::Name &itrVal{GetLoopIndex(loop)}; - SetLoopIv(itrVal.symbol); - } + if (const auto *loop{x.GetNestedLoop()}) { + if (loop->IsDoNormal()) { + const parser::Name &itrVal{GetLoopIndex(loop)}; + SetLoopIv(itrVal.symbol); } } } void OmpStructureChecker::CheckLoopItrVariableIsInt( const parser::OpenMPLoopConstruct &x) { - auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if<parser::DoConstruct>(&*optLoopCons)}) { - - for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) { - if (loop->IsDoNormal()) { - const parser::Name &itrVal{GetLoopIndex(loop)}; - if (itrVal.symbol) { - const auto *type{itrVal.symbol->GetType()}; - if (!type->IsNumeric(TypeCategory::Integer)) { - context_.Say(itrVal.source, - "The DO loop iteration" - " variable must be of the type integer."_err_en_US, - itrVal.ToString()); - } + for (auto &construct : std::get<parser::Block>(x.t)) { + for (const parser::DoConstruct *loop{ + parser::omp::GetDoConstruct(construct)}; + loop;) { + if (loop->IsDoNormal()) { + const parser::Name &itrVal{GetLoopIndex(loop)}; + if (itrVal.symbol) { + const auto *type{itrVal.symbol->GetType()}; + if (!type->IsNumeric(TypeCategory::Integer)) { + context_.Say(itrVal.source, + "The DO loop iteration" + " variable must be of the type integer."_err_en_US, + itrVal.ToString()); } } - // Get the next DoConstruct if block is not empty. - const auto &block{std::get<parser::Block>(loop->t)}; - const auto it{block.begin()}; - loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) - : nullptr; } + // Get the next DoConstruct if block is not empty. + const auto &block{std::get<parser::Block>(loop->t)}; + const auto it{block.begin()}; + loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) + : nullptr; } } } @@ -401,9 +499,8 @@ void OmpStructureChecker::CheckDistLinear( // Collect symbols of all the variables from linear clauses for (auto &clause : clauses.v) { - if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) { - auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)}; - GetSymbolsInObjectList(objects, indexVars); + if (std::get_if<parser::OmpClause::Linear>(&clause.u)) { + GetSymbolsInObjectList(*parser::omp::GetOmpObjectList(clause), indexVars); } } @@ -417,28 +514,27 @@ void OmpStructureChecker::CheckDistLinear( // Match the loop index variables with the collected symbols from linear // clauses. - auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t); - if (optLoopCons.has_value()) { - if (const auto &loopConstruct{ - std::get_if<parser::DoConstruct>(&*optLoopCons)}) { - for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) { - if (loop->IsDoNormal()) { - const parser::Name &itrVal{GetLoopIndex(loop)}; - if (itrVal.symbol) { - // Remove the symbol from the collected set - indexVars.erase(&itrVal.symbol->GetUltimate()); - } - collapseVal--; - if (collapseVal == 0) { - break; - } + for (auto &construct : std::get<parser::Block>(x.t)) { + std::int64_t curCollapseVal{collapseVal}; + for (const parser::DoConstruct *loop{ + parser::omp::GetDoConstruct(construct)}; + loop;) { + if (loop->IsDoNormal()) { + const parser::Name &itrVal{GetLoopIndex(loop)}; + if (itrVal.symbol) { + // Remove the symbol from the collected set + indexVars.erase(&itrVal.symbol->GetUltimate()); + } + curCollapseVal--; + if (curCollapseVal == 0) { + break; } - // Get the next DoConstruct if block is not empty. - const auto &block{std::get<parser::Block>(loop->t)}; - const auto it{block.begin()}; - loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) - : nullptr; } + // Get the next DoConstruct if block is not empty. + const auto &block{std::get<parser::Block>(loop->t)}; + const auto it{block.begin()}; + loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it) + : nullptr; } } @@ -452,6 +548,101 @@ void OmpStructureChecker::CheckDistLinear( } } +void OmpStructureChecker::CheckLooprangeBounds( + const parser::OpenMPLoopConstruct &x) { + const parser::OmpClauseList &clauseList{x.BeginDir().Clauses()}; + if (clauseList.v.empty()) { + return; + } + for (auto &clause : clauseList.v) { + if (const auto *lrClause{ + std::get_if<parser::OmpClause::Looprange>(&clause.u)}) { + auto first{GetIntValue(std::get<0>((lrClause->v).t))}; + auto count{GetIntValue(std::get<1>((lrClause->v).t))}; + if (!first || !count) { + return; + } + auto &loopConsList{std::get<parser::Block>(x.t)}; + if (*first > 0 && *count > 0 && + loopConsList.size() < (unsigned)(*first + *count - 1)) { + context_.Say(clause.source, + "The loop range indicated in the %s clause must not be out of the bounds of the Loop Sequence following the construct."_err_en_US, + parser::ToUpperCaseLetters(clause.source.ToString())); + } + return; + } + } +} + +void OmpStructureChecker::CheckNestedFuse( + const parser::OpenMPLoopConstruct &x) { + auto &loopConsList{std::get<parser::Block>(x.t)}; + if (loopConsList.empty()) { + return; + } + const auto *ompConstruct{parser::omp::GetOmpLoop(loopConsList.front())}; + if (!ompConstruct) { + return; + } + const parser::OmpClauseList &clauseList{ompConstruct->BeginDir().Clauses()}; + if (clauseList.v.empty()) { + return; + } + for (auto &clause : clauseList.v) { + if (const auto *lrClause{ + std::get_if<parser::OmpClause::Looprange>(&clause.u)}) { + auto count{GetIntValue(std::get<1>((lrClause->v).t))}; + if (!count) { + return; + } + auto &nestedLoopConsList{std::get<parser::Block>(ompConstruct->t)}; + if (nestedLoopConsList.size() > (unsigned)(*count)) { + context_.Say(x.BeginDir().DirName().source, + "The loop sequence following the %s construct must be fully fused first."_err_en_US, + parser::ToUpperCaseLetters( + x.BeginDir().DirName().source.ToString())); + } + return; + } + } +} + +void OmpStructureChecker::CheckScanModifier( + const parser::OmpClause::Reduction &x) { + using ReductionModifier = parser::OmpReductionModifier; + + auto checkReductionSymbolInScan{[&](const parser::Name &name) { + if (auto *symbol{name.symbol}) { + if (!symbol->test(Symbol::Flag::OmpInclusiveScan) && + !symbol->test(Symbol::Flag::OmpExclusiveScan)) { + context_.Say(name.source, + "List item %s must appear in EXCLUSIVE or INCLUSIVE clause of an enclosed SCAN directive"_err_en_US, + name.ToString()); + } + } + }}; + + auto &modifiers{OmpGetModifiers(x.v)}; + auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}; + if (maybeModifier && maybeModifier->v == ReductionModifier::Value::Inscan) { + for (const auto &ompObj : parser::omp::GetOmpObjectList(x)->v) { + common::visit( + common::visitors{ + [&](const parser::Designator &desg) { + if (auto *name{parser::GetDesignatorNameIfDataRef(desg)}) { + checkReductionSymbolInScan(*name); + } + }, + [&](const parser::Name &name) { + checkReductionSymbolInScan(name); + }, + [&](const parser::OmpObject::Invalid &invalid) {}, + }, + ompObj.u); + } + } +} + void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) { const parser::OmpClauseList &clauseList{x.BeginDir().Clauses()}; @@ -459,45 +650,9 @@ void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) { // constructs inside LOOP may add the relevant information. Scan reduction is // supported only in loop constructs, so same checks are not applicable to // other directives. - using ReductionModifier = parser::OmpReductionModifier; for (const auto &clause : clauseList.v) { - if (const auto *reductionClause{ - std::get_if<parser::OmpClause::Reduction>(&clause.u)}) { - auto &modifiers{OmpGetModifiers(reductionClause->v)}; - auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}; - if (maybeModifier && - maybeModifier->v == ReductionModifier::Value::Inscan) { - const auto &objectList{ - std::get<parser::OmpObjectList>(reductionClause->v.t)}; - auto checkReductionSymbolInScan = [&](const parser::Name *name) { - if (auto &symbol = name->symbol) { - if (!symbol->test(Symbol::Flag::OmpInclusiveScan) && - !symbol->test(Symbol::Flag::OmpExclusiveScan)) { - context_.Say(name->source, - "List item %s must appear in EXCLUSIVE or " - "INCLUSIVE clause of an " - "enclosed SCAN directive"_err_en_US, - name->ToString()); - } - } - }; - for (const auto &ompObj : objectList.v) { - common::visit( - common::visitors{ - [&](const parser::Designator &designator) { - if (const auto *name{ - parser::GetDesignatorNameIfDataRef(designator)}) { - checkReductionSymbolInScan(name); - } - }, - [&](const parser::Name &name) { - checkReductionSymbolInScan(&name); - }, - [&](const parser::OmpObject::Invalid &invalid) {}, - }, - ompObj.u); - } - } + if (auto *reduction{std::get_if<parser::OmpClause::Reduction>(&clause.u)}) { + CheckScanModifier(*reduction); } } if (llvm::omp::allSimdSet.test(GetContext().directive)) { @@ -636,6 +791,20 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { } } +void OmpStructureChecker::Enter(const parser::OmpClause::Sizes &c) { + CheckAllowedClause(llvm::omp::Clause::OMPC_sizes); + for (const parser::Cosubscript &v : c.v) + RequiresPositiveParameter(llvm::omp::Clause::OMPC_sizes, v, + /*paramName=*/"parameter", /*allowZero=*/false); +} + +void OmpStructureChecker::Enter(const parser::OmpClause::Looprange &x) { + CheckAllowedClause(llvm::omp::Clause::OMPC_looprange); + auto &[first, count]{x.v.t}; + RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_looprange, count); + RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_looprange, first); +} + void OmpStructureChecker::Enter(const parser::DoConstruct &x) { Base::Enter(x); loopStack_.push_back(&x); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index d7db15d..7776f0d 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -624,11 +624,9 @@ void OmpStructureChecker::CheckMultListItems() { // Linear clause for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) { - auto &linearClause{std::get<parser::OmpClause::Linear>(clause->u)}; std::list<parser::Name> nameList; SymbolSourceMap symbols; - GetSymbolsInObjectList( - std::get<parser::OmpObjectList>(linearClause.v.t), symbols); + GetSymbolsInObjectList(*GetOmpObjectList(*clause), symbols); llvm::transform(symbols, std::back_inserter(nameList), [&](auto &&pair) { return parser::Name{pair.second, const_cast<Symbol *>(pair.first)}; }); @@ -682,6 +680,13 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) { } } +void OmpStructureChecker::Enter(const parser::OmpClause::DynGroupprivate &x) { + CheckAllowedClause(llvm::omp::Clause::OMPC_dyn_groupprivate); + parser::CharBlock source{GetContext().clauseSource}; + + OmpVerifyModifiers(x.v, llvm::omp::OMPC_dyn_groupprivate, source, context_); +} + void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) { // OmpDirectiveSpecification exists on its own only in METADIRECTIVE. // In other cases it's a part of other constructs that handle directive @@ -2094,29 +2099,29 @@ void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) { } } - bool toClauseFound{false}, deviceTypeClauseFound{false}, - enterClauseFound{false}; + bool toClauseFound{false}; + bool deviceTypeClauseFound{false}; + bool enterClauseFound{false}; for (const parser::OmpClause &clause : x.v.Clauses().v) { common::visit( common::visitors{ - [&](const parser::OmpClause::To &toClause) { - toClauseFound = true; - auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)}; - CheckSymbolNames(dirName.source, objList); - CheckVarIsNotPartOfAnotherVar(dirName.source, objList); - CheckThreadprivateOrDeclareTargetVar(objList); - }, - [&](const parser::OmpClause::Link &linkClause) { - CheckSymbolNames(dirName.source, linkClause.v); - CheckVarIsNotPartOfAnotherVar(dirName.source, linkClause.v); - CheckThreadprivateOrDeclareTargetVar(linkClause.v); - }, - [&](const parser::OmpClause::Enter &enterClause) { - enterClauseFound = true; - auto &objList{std::get<parser::OmpObjectList>(enterClause.v.t)}; - CheckSymbolNames(dirName.source, objList); - CheckVarIsNotPartOfAnotherVar(dirName.source, objList); - CheckThreadprivateOrDeclareTargetVar(objList); + [&](const auto &c) { + using TypeC = llvm::remove_cvref_t<decltype(c)>; + if constexpr ( // + std::is_same_v<TypeC, parser::OmpClause::Enter> || + std::is_same_v<TypeC, parser::OmpClause::Link> || + std::is_same_v<TypeC, parser::OmpClause::To>) { + auto &objList{*GetOmpObjectList(c)}; + CheckSymbolNames(dirName.source, objList); + CheckVarIsNotPartOfAnotherVar(dirName.source, objList); + CheckThreadprivateOrDeclareTargetVar(objList); + } + if constexpr (std::is_same_v<TypeC, parser::OmpClause::Enter>) { + enterClauseFound = true; + } + if constexpr (std::is_same_v<TypeC, parser::OmpClause::To>) { + toClauseFound = true; + } }, [&](const parser::OmpClause::DeviceType &deviceTypeClause) { deviceTypeClauseFound = true; @@ -2127,7 +2132,6 @@ void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) { deviceConstructFound_ = true; } }, - [&](const auto &) {}, }, clause.u); @@ -2417,12 +2421,8 @@ void OmpStructureChecker::CheckTargetUpdate() { } if (toWrapper && fromWrapper) { SymbolSourceMap toSymbols, fromSymbols; - auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v}; - auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v}; - GetSymbolsInObjectList( - std::get<parser::OmpObjectList>(fromClause.t), fromSymbols); - GetSymbolsInObjectList( - std::get<parser::OmpObjectList>(toClause.t), toSymbols); + GetSymbolsInObjectList(*GetOmpObjectList(*fromWrapper), fromSymbols); + GetSymbolsInObjectList(*GetOmpObjectList(*toWrapper), toSymbols); for (auto &[symbol, source] : toSymbols) { auto fromSymbol{fromSymbols.find(symbol)}; @@ -2741,8 +2741,8 @@ void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) { unsigned version{context_.langOptions().OpenMPVersion}; if (version >= 52) { - using Flags = parser::OmpDirectiveSpecification::Flags; - if (std::get<Flags>(x.v.t) == Flags::DeprecatedSyntax) { + auto &flags{std::get<parser::OmpDirectiveSpecification::Flags>(x.v.t)}; + if (flags.test(parser::OmpDirectiveSpecification::Flag::DeprecatedSyntax)) { context_.Say(x.source, "The syntax \"FLUSH clause (object, ...)\" has been deprecated, use \"FLUSH(object, ...) clause\" instead"_warn_en_US); } @@ -2800,7 +2800,7 @@ void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) { void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { const parser::OmpBeginDirective &beginSpec{x.BeginDir()}; const std::optional<parser::OmpEndDirective> &endSpec{x.EndDir()}; - PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirName().v); + PushContextAndClauseSets(beginSpec.DirName().source, beginSpec.DirId()); const auto &block{std::get<parser::Block>(x.t)}; CheckNoBranching( @@ -3262,7 +3262,7 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) { const auto &irClause{ std::get<parser::OmpClause::InReduction>(dataEnvClause->u)}; checkVarAppearsInDataEnvClause( - std::get<parser::OmpObjectList>(irClause.v.t), "IN_REDUCTION"); + *GetOmpObjectList(irClause), "IN_REDUCTION"); } } } @@ -3316,6 +3316,32 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) { } } + // Default access-group for DYN_GROUPPRIVATE is "cgroup". On a given + // construct there can be at most one DYN_GROUPPRIVATE with a given + // access-group. + const parser::OmpClause + *accGrpClause[parser::OmpAccessGroup::Value_enumSize] = {nullptr}; + for (auto [_, clause] : + FindClauses(llvm::omp::Clause::OMPC_dyn_groupprivate)) { + auto &wrapper{std::get<parser::OmpClause::DynGroupprivate>(clause->u)}; + auto &modifiers{OmpGetModifiers(wrapper.v)}; + auto accGrp{parser::OmpAccessGroup::Value::Cgroup}; + if (auto *ag{OmpGetUniqueModifier<parser::OmpAccessGroup>(modifiers)}) { + accGrp = ag->v; + } + auto &firstClause{accGrpClause[llvm::to_underlying(accGrp)]}; + if (firstClause) { + context_ + .Say(clause->source, + "The access-group modifier can only occur on a single clause in a construct"_err_en_US) + .Attach(firstClause->source, + "Previous clause with access-group modifier"_en_US); + break; + } else { + firstClause = clause; + } + } + CheckRequireAtLeastOneOf(); } @@ -3360,19 +3386,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause &x) { } } -void OmpStructureChecker::Enter(const parser::OmpClause::Sizes &c) { - CheckAllowedClause(llvm::omp::Clause::OMPC_sizes); - for (const parser::Cosubscript &v : c.v) - RequiresPositiveParameter(llvm::omp::Clause::OMPC_sizes, v, - /*paramName=*/"parameter", /*allowZero=*/false); -} - -void OmpStructureChecker::Enter(const parser::OmpClause::Looprange &x) { - context_.Say(GetContext().clauseSource, - "LOOPRANGE clause is not implemented yet"_err_en_US, - ContextDirectiveAsFortran()); -} - // Restrictions specific to each clause are implemented apart from the // generalized restrictions. @@ -3401,7 +3414,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) { void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_reduction); - auto &objects{std::get<parser::OmpObjectList>(x.v.t)}; + auto &objects{*GetOmpObjectList(x)}; if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_reduction, GetContext().clauseSource, context_)) { @@ -3441,7 +3454,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) { void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_in_reduction); - auto &objects{std::get<parser::OmpObjectList>(x.v.t)}; + auto &objects{*GetOmpObjectList(x)}; if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_in_reduction, GetContext().clauseSource, context_)) { @@ -3459,7 +3472,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) { void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_task_reduction); - auto &objects{std::get<parser::OmpObjectList>(x.v.t)}; + auto &objects{*GetOmpObjectList(x)}; if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_task_reduction, GetContext().clauseSource, context_)) { @@ -4312,8 +4325,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) { }}; evaluate::ExpressionAnalyzer ea{context_}; - const auto &objects{std::get<parser::OmpObjectList>(x.v.t)}; - for (auto &object : objects.v) { + for (auto &object : GetOmpObjectList(x)->v) { if (const parser::Designator *d{GetDesignatorFromObj(object)}) { if (auto &&expr{ea.Analyze(*d)}) { if (hasBasePointer(*expr)) { @@ -4466,7 +4478,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) { } } if (taskDep) { - auto &objList{std::get<parser::OmpObjectList>(taskDep->t)}; + auto &objList{*GetOmpObjectList(*taskDep)}; if (dir == llvm::omp::OMPD_depobj) { // [5.0:255:13], [5.1:288:6], [5.2:322:26] // A depend clause on a depobj construct must only specify one locator. @@ -4612,7 +4624,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) { void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_lastprivate); - const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)}; + const auto &objectList{*GetOmpObjectList(x)}; CheckVarIsNotPartOfAnotherVar( GetContext().clauseSource, objectList, "LASTPRIVATE"); CheckCrayPointee(objectList, "LASTPRIVATE"); @@ -4673,10 +4685,12 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) { void OmpStructureChecker::CheckStructureComponent( const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) { auto CheckComponent{[&](const parser::Designator &designator) { - if (auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}) { + if (const parser::DataRef *dataRef{ + std::get_if<parser::DataRef>(&designator.u)}) { if (!IsDataRefTypeParamInquiry(dataRef)) { - if (auto *comp{parser::Unwrap<parser::StructureComponent>(*dataRef)}) { - context_.Say(comp->component.source, + const auto expr{AnalyzeExpr(context_, designator)}; + if (expr.has_value() && evaluate::HasStructureComponent(expr.value())) { + context_.Say(designator.source, "A variable that is part of another variable cannot appear on the %s clause"_err_en_US, parser::ToUpperCaseLetters(getClauseName(clauseId).str())); } @@ -4852,9 +4866,8 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) { x.v, llvm::omp::OMPC_enter, GetContext().clauseSource, context_)) { return; } - const parser::OmpObjectList &objList{std::get<parser::OmpObjectList>(x.v.t)}; SymbolSourceMap symbols; - GetSymbolsInObjectList(objList, symbols); + GetSymbolsInObjectList(*GetOmpObjectList(x), symbols); for (const auto &[symbol, source] : symbols) { if (!IsExtendedListItem(*symbol)) { context_.SayWithDecl(*symbol, source, @@ -4877,7 +4890,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::From &x) { CheckIteratorModifier(*iter); } - const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; + const auto &objList{*GetOmpObjectList(x)}; SymbolSourceMap symbols; GetSymbolsInObjectList(objList, symbols); CheckVariableListItem(symbols); @@ -4917,7 +4930,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::To &x) { CheckIteratorModifier(*iter); } - const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; + const auto &objList{*GetOmpObjectList(x)}; SymbolSourceMap symbols; GetSymbolsInObjectList(objList, symbols); CheckVariableListItem(symbols); @@ -5180,6 +5193,13 @@ bool OmpStructureChecker::CheckTargetBlockOnlyTeams( if (dirId == llvm::omp::Directive::OMPD_teams) { nestedTeams = true; } + } else if (const auto *ompLoopConstruct{ + std::get_if<parser::OpenMPLoopConstruct>( + &ompConstruct->u)}) { + llvm::omp::Directive dirId{ompLoopConstruct->BeginDir().DirId()}; + if (llvm::omp::topTeamsSet.test(dirId)) { + nestedTeams = true; + } } } @@ -5439,6 +5459,25 @@ void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) { } } +void OmpStructureChecker::Enter(const parser::OpenMPMisplacedEndDirective &x) { + context_.Say(x.DirName().source, "Misplaced OpenMP end-directive"_err_en_US); + PushContextAndClauseSets( + x.DirName().source, llvm::omp::Directive::OMPD_unknown); +} + +void OmpStructureChecker::Leave(const parser::OpenMPMisplacedEndDirective &x) { + dirContext_.pop_back(); +} + +void OmpStructureChecker::Enter(const parser::OpenMPInvalidDirective &x) { + context_.Say(x.source, "Invalid OpenMP directive"_err_en_US); + PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_unknown); +} + +void OmpStructureChecker::Leave(const parser::OpenMPInvalidDirective &x) { + dirContext_.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 &) { \ @@ -5466,13 +5505,13 @@ CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity) CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args) CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind) CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture) +CHECK_SIMPLE_CLAUSE(Collector, OMPC_collector) CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare) CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains) CHECK_SIMPLE_CLAUSE(Default, OMPC_default) CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj) CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type) CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule) -CHECK_SIMPLE_CLAUSE(DynGroupprivate, OMPC_dyn_groupprivate) CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive) CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail) CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) @@ -5487,6 +5526,7 @@ CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds) CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch) CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive) CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect) +CHECK_SIMPLE_CLAUSE(Inductor, OMPC_inductor) CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer) CHECK_SIMPLE_CLAUSE(Init, OMPC_init) CHECK_SIMPLE_CLAUSE(Link, OMPC_link) diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 1b84bc5..5bd5ae0 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -94,6 +94,11 @@ public: void Enter(const parser::OpenMPDeclarativeConstruct &); void Leave(const parser::OpenMPDeclarativeConstruct &); + void Enter(const parser::OpenMPMisplacedEndDirective &); + void Leave(const parser::OpenMPMisplacedEndDirective &); + void Enter(const parser::OpenMPInvalidDirective &); + void Leave(const parser::OpenMPInvalidDirective &); + void Enter(const parser::OpenMPLoopConstruct &); void Leave(const parser::OpenMPLoopConstruct &); void Enter(const parser::OmpEndLoopDirective &); @@ -316,8 +321,15 @@ private: void CheckAtomicWrite(const parser::OpenMPAtomicConstruct &x); void CheckAtomicUpdate(const parser::OpenMPAtomicConstruct &x); + void CheckScanModifier(const parser::OmpClause::Reduction &x); + void CheckLooprangeBounds(const parser::OpenMPLoopConstruct &x); + void CheckNestedFuse(const parser::OpenMPLoopConstruct &x); void CheckDistLinear(const parser::OpenMPLoopConstruct &x); void CheckSIMDNest(const parser::OpenMPConstruct &x); + void CheckNestedBlock(const parser::OpenMPLoopConstruct &x, + const parser::Block &body, size_t &nestedCount); + void CheckNestedConstruct(const parser::OpenMPLoopConstruct &x); + void CheckFullUnroll(const parser::OpenMPLoopConstruct &x); void CheckTargetNest(const parser::OpenMPConstruct &x); void CheckTargetUpdate(); void CheckTaskgraph(const parser::OmpBlockConstruct &x); diff --git a/flang/lib/Semantics/dump-expr.cpp b/flang/lib/Semantics/dump-expr.cpp index 66cedab..8d354cf 100644 --- a/flang/lib/Semantics/dump-expr.cpp +++ b/flang/lib/Semantics/dump-expr.cpp @@ -23,6 +23,7 @@ void DumpEvaluateExpr::Show(const evaluate::CoarrayRef &x) { Indent("coarray ref"); Show(x.base()); Show(x.cosubscript()); + Show(x.notify()); Show(x.stat()); Show(x.team()); Outdent(); diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index c8167fd..6f5d0bf 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1579,6 +1579,19 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) { std::get<std::list<parser::ImageSelectorSpec>>(x.imageSelector.t)) { common::visit( common::visitors{ + [&](const parser::ImageSelectorSpec::Notify &x) { + Analyze(x.v); + if (const auto *expr{GetExpr(context_, x.v)}) { + if (coarrayRef.notify()) { + Say("coindexed reference has multiple NOTIFY= specifiers"_err_en_US); + } else if (auto dyType{expr->GetType()}; + dyType && IsNotifyType(GetDerivedTypeSpec(*dyType))) { + coarrayRef.set_notify(Expr<SomeType>{*expr}); + } else { + Say("NOTIFY= specifier must have type NOTIFY_TYPE from ISO_FORTRAN_ENV"_err_en_US); + } + } + }, [&](const parser::ImageSelectorSpec::Stat &x) { Analyze(x.v); if (const auto *expr{GetExpr(context_, x.v)}) { @@ -2090,17 +2103,32 @@ static MaybeExpr ImplicitConvertTo(const Symbol &sym, Expr<SomeType> &&expr, } MaybeExpr ExpressionAnalyzer::CheckStructureConstructor( - parser::CharBlock typeName, const semantics::DerivedTypeSpec &spec, + parser::CharBlock typeName, const semantics::DerivedTypeSpec &spec0, std::list<ComponentSpec> &&componentSpecs) { + semantics::Scope &scope{context_.FindScope(typeName)}; + FoldingContext &foldingContext{GetFoldingContext()}; + const semantics::DerivedTypeSpec *effectiveSpec{&spec0}; + if (foldingContext.pdtInstance() && spec0.MightBeParameterized()) { + // We're processing a structure constructor in the context of a derived + // type instantiation, and the derived type of the structure constructor + // is parameterized. Evaluate its parameters in the context of the + // instantiation in progress so that the components in constructor's scope + // have the correct types. + semantics::DerivedTypeSpec newSpec{spec0}; + newSpec.ReevaluateParameters(context()); + const semantics::DeclTypeSpec &instantiatedType{ + semantics::FindOrInstantiateDerivedType( + scope, std::move(newSpec), semantics::DeclTypeSpec::TypeDerived)}; + effectiveSpec = &instantiatedType.derivedTypeSpec(); + } + const semantics::DerivedTypeSpec &spec{*effectiveSpec}; const Symbol &typeSymbol{spec.typeSymbol()}; if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) { return std::nullopt; // error recovery } - const semantics::Scope &scope{context_.FindScope(typeName)}; const semantics::Scope *pureContext{FindPureProcedureContaining(scope)}; const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()}; const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())}; - if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796 AttachDeclaration( Say(typeName, @@ -2140,6 +2168,9 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor( parser::CharBlock exprSource{componentSpec.exprSource}; auto restorer{messages.SetLocation(source)}; const Symbol *symbol{componentSpec.keywordSymbol}; + if (symbol) { + symbol = spec.scope()->FindComponent(symbol->name()); + } MaybeExpr &maybeValue{componentSpec.expr}; if (!maybeValue.has_value()) { return std::nullopt; @@ -2315,7 +2346,6 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor( // convert would cause a segfault. Lowering will deal with // conditionally converting and preserving the lower bounds in this // case. - FoldingContext &foldingContext{GetFoldingContext()}; if (MaybeExpr converted{ImplicitConvertTo(*symbol, std::move(value), /*keepConvertImplicit=*/IsAllocatable(*symbol), foldingContext)}) { diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index b419864..840b98d 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -59,6 +59,7 @@ static void PutBound(llvm::raw_ostream &, const Bound &); static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &); static void PutShape( llvm::raw_ostream &, const ArraySpec &, char open, char close); +static void PutMapper(llvm::raw_ostream &, const Symbol &, SemanticsContext &); static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr); static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &); @@ -938,6 +939,7 @@ void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) { [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); }, [&](const TypeParamDetails &) { PutTypeParam(os, symbol); }, [&](const UserReductionDetails &) { PutUserReduction(os, symbol); }, + [&](const MapperDetails &) { PutMapper(decls_, symbol, context_); }, [&](const auto &) { common::die("PutEntity: unexpected details: %s", DetailsToString(symbol.details()).c_str()); @@ -1101,6 +1103,16 @@ void ModFileWriter::PutUserReduction( } } +static void PutMapper( + llvm::raw_ostream &os, const Symbol &symbol, SemanticsContext &context) { + const auto &details{symbol.get<MapperDetails>()}; + // Emit each saved DECLARE MAPPER construct as-is, so that consumers of the + // module can reparse it and recreate the mapper symbol and semantics state. + for (const auto *decl : details.GetDeclList()) { + Unparse(os, *decl, context.langOptions()); + } +} + void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init, const parser::Expr *unanalyzed, SemanticsContext &context) { if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) { diff --git a/flang/lib/Semantics/openmp-modifiers.cpp b/flang/lib/Semantics/openmp-modifiers.cpp index 717fb03..f191b4d 100644 --- a/flang/lib/Semantics/openmp-modifiers.cpp +++ b/flang/lib/Semantics/openmp-modifiers.cpp @@ -75,6 +75,22 @@ unsigned OmpModifierDescriptor::since(llvm::omp::Clause id) const { // generated in the future. template <> +const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAccessGroup>() { + static const OmpModifierDescriptor desc{ + /*name=*/"access-group", + /*props=*/ + { + {61, {OmpProperty::Unique}}, + }, + /*clauses=*/ + { + {61, {Clause::OMPC_dyn_groupprivate}}, + }, + }; + return desc; +} + +template <> const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpAlignment>() { static const OmpModifierDescriptor desc{ /*name=*/"alignment", @@ -322,6 +338,22 @@ const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpExpectation>() { } template <> +const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpFallbackModifier>() { + static const OmpModifierDescriptor desc{ + /*name=*/"fallback-modifier", + /*props=*/ + { + {61, {OmpProperty::Unique}}, + }, + /*clauses=*/ + { + {61, {Clause::OMPC_dyn_groupprivate}}, + }, + }; + return desc; +} + +template <> const OmpModifierDescriptor &OmpGetDescriptor<parser::OmpInteropPreference>() { static const OmpModifierDescriptor desc{ /*name=*/"interop-preference", diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 4a40d6e..18a37d6 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -496,32 +496,4 @@ bool IsPointerAssignment(const evaluate::Assignment &x) { return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) || std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u); } - -/// parser::Block is a list of executable constructs, parser::BlockConstruct -/// is Fortran's BLOCK/ENDBLOCK construct. -/// Strip the outermost BlockConstructs, return the reference to the Block -/// in the executable part of the innermost of the stripped constructs. -/// Specifically, if the given `block` has a single entry (it's a list), and -/// the entry is a BlockConstruct, get the Block contained within. Repeat -/// this step as many times as possible. -const parser::Block &GetInnermostExecPart(const parser::Block &block) { - const parser::Block *iter{&block}; - while (iter->size() == 1) { - const parser::ExecutionPartConstruct &ep{iter->front()}; - if (auto *bc{GetFortranBlockConstruct(ep)}) { - iter = &std::get<parser::Block>(bc->t); - } else { - break; - } - } - return *iter; -} - -bool IsStrictlyStructuredBlock(const parser::Block &block) { - if (block.size() == 1) { - return GetFortranBlockConstruct(block.front()) != nullptr; - } else { - return false; - } -} } // namespace Fortran::semantics::omp diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index deb57e0..6211643 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -525,10 +525,16 @@ public: void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); } bool Pre(const parser::OpenMPLoopConstruct &); - void Post(const parser::OpenMPLoopConstruct &) { PopContext(); } + void Post(const parser::OpenMPLoopConstruct &) { + ordCollapseLevel++; + PopContext(); + } void Post(const parser::OmpBeginLoopDirective &) { GetContext().withinConstruct = true; } + bool Pre(const parser::OpenMPMisplacedEndDirective &x) { return false; } + bool Pre(const parser::OpenMPInvalidDirective &x) { return false; } + bool Pre(const parser::DoConstruct &); bool Pre(const parser::OpenMPSectionsConstruct &); @@ -711,8 +717,8 @@ public: return false; } bool Pre(const parser::OmpAllocateClause &x) { - const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; - ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate); + ResolveOmpObjectList( + *parser::omp::GetOmpObjectList(x), Symbol::Flag::OmpAllocate); return false; } bool Pre(const parser::OmpClause::Firstprivate &x) { @@ -720,8 +726,8 @@ public: return false; } bool Pre(const parser::OmpClause::Lastprivate &x) { - const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; - ResolveOmpObjectList(objList, Symbol::Flag::OmpLastPrivate); + ResolveOmpObjectList( + *parser::omp::GetOmpObjectList(x), Symbol::Flag::OmpLastPrivate); return false; } bool Pre(const parser::OmpClause::Copyin &x) { @@ -733,8 +739,8 @@ public: return false; } bool Pre(const parser::OmpLinearClause &x) { - auto &objects{std::get<parser::OmpObjectList>(x.t)}; - ResolveOmpObjectList(objects, Symbol::Flag::OmpLinear); + ResolveOmpObjectList( + *parser::omp::GetOmpObjectList(x), Symbol::Flag::OmpLinear); return false; } @@ -744,13 +750,13 @@ public: } bool Pre(const parser::OmpInReductionClause &x) { - auto &objects{std::get<parser::OmpObjectList>(x.t)}; - ResolveOmpObjectList(objects, Symbol::Flag::OmpInReduction); + ResolveOmpObjectList( + *parser::omp::GetOmpObjectList(x), Symbol::Flag::OmpInReduction); return false; } bool Pre(const parser::OmpClause::Reduction &x) { - const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; + const auto &objList{*parser::omp::GetOmpObjectList(x)}; ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction); if (auto &modifiers{OmpGetModifiers(x.v)}) { @@ -800,8 +806,8 @@ public: } bool Pre(const parser::OmpAlignedClause &x) { - const auto &alignedNameList{std::get<parser::OmpObjectList>(x.t)}; - ResolveOmpObjectList(alignedNameList, Symbol::Flag::OmpAligned); + ResolveOmpObjectList( + *parser::omp::GetOmpObjectList(x), Symbol::Flag::OmpAligned); return false; } @@ -914,7 +920,7 @@ public: } } - const auto &ompObjList{std::get<parser::OmpObjectList>(x.t)}; + const auto &ompObjList{*parser::omp::GetOmpObjectList(x)}; for (const auto &ompObj : ompObjList.v) { common::visit( common::visitors{ @@ -2028,6 +2034,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd: case llvm::omp::Directive::OMPD_teams_distribute_simd: case llvm::omp::Directive::OMPD_teams_loop: + case llvm::omp::Directive::OMPD_fuse: case llvm::omp::Directive::OMPD_tile: case llvm::omp::Directive::OMPD_unroll: PushContext(beginName.source, beginName.v); @@ -2038,8 +2045,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { if (beginName.v == llvm::omp::OMPD_master_taskloop || beginName.v == llvm::omp::OMPD_master_taskloop_simd || beginName.v == llvm::omp::OMPD_parallel_master_taskloop || - beginName.v == llvm::omp::OMPD_parallel_master_taskloop_simd || - beginName.v == llvm::omp::Directive::OMPD_target_loop) { + beginName.v == llvm::omp::OMPD_parallel_master_taskloop_simd) { unsigned version{context_.langOptions().OpenMPVersion}; IssueNonConformanceWarning(beginName.v, beginName.source, version); } @@ -2047,13 +2053,9 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { SetContextAssociatedLoopLevel(GetNumAffectedLoopsFromLoopConstruct(x)); if (beginName.v == llvm::omp::Directive::OMPD_do) { - auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t); - if (optLoopCons.has_value()) { - if (const auto &doConstruct{ - std::get_if<parser::DoConstruct>(&*optLoopCons)}) { - if (doConstruct->IsDoWhile()) { - return true; - } + if (const parser::DoConstruct *doConstruct{x.GetNestedLoop()}) { + if (doConstruct->IsDoWhile()) { + return true; } } } @@ -2210,18 +2212,11 @@ void OmpAttributeVisitor::CollectNumAffectedLoopsFromInnerLoopContruct( const parser::OpenMPLoopConstruct &x, llvm::SmallVector<std::int64_t> &levels, llvm::SmallVector<const parser::OmpClause *> &clauses) { - - const auto &nestedOptional = - std::get<std::optional<parser::NestedConstruct>>(x.t); - assert(nestedOptional.has_value() && - "Expected a DoConstruct or OpenMPLoopConstruct"); - const auto *innerConstruct = - std::get_if<common::Indirection<parser::OpenMPLoopConstruct>>( - &(nestedOptional.value())); - - if (innerConstruct) { - CollectNumAffectedLoopsFromLoopConstruct( - innerConstruct->value(), levels, clauses); + for (auto &construct : std::get<parser::Block>(x.t)) { + if (auto *innerConstruct{parser::omp::GetOmpLoop(construct)}) { + CollectNumAffectedLoopsFromLoopConstruct( + *innerConstruct, levels, clauses); + } } } @@ -2286,86 +2281,74 @@ void OmpAttributeVisitor::CheckPerfectNestAndRectangularLoop( // Find the associated region by skipping nested loop-associated constructs // such as loop transformations - const parser::NestedConstruct *innermostAssocRegion{nullptr}; - const parser::OpenMPLoopConstruct *innermostConstruct{&x}; - while (const auto &innerAssocStmt{ - std::get<std::optional<parser::NestedConstruct>>( - innermostConstruct->t)}) { - innermostAssocRegion = &(innerAssocStmt.value()); - if (const auto *innerConstruct{ - std::get_if<common::Indirection<parser::OpenMPLoopConstruct>>( - innermostAssocRegion)}) { - innermostConstruct = &innerConstruct->value(); - } else { - break; - } - } - - if (!innermostAssocRegion) - return; - const auto &outer{std::get_if<parser::DoConstruct>(innermostAssocRegion)}; - if (!outer) - return; - - llvm::SmallVector<Symbol *> ivs; - int curLevel{0}; - const parser::DoConstruct *loop{outer}; - while (true) { - auto [iv, lb, ub, step] = GetLoopBounds(*loop); - - if (lb) - checkExprHasSymbols(ivs, lb); - if (ub) - checkExprHasSymbols(ivs, ub); - if (step) - checkExprHasSymbols(ivs, step); - if (iv) { - if (auto *symbol{currScope().FindSymbol(iv->source)}) - ivs.push_back(symbol); - } + for (auto &construct : std::get<parser::Block>(x.t)) { + if (const auto *innermostConstruct{parser::omp::GetOmpLoop(construct)}) { + CheckPerfectNestAndRectangularLoop(*innermostConstruct); + } else if (const auto *doConstruct{ + parser::omp::GetDoConstruct(construct)}) { + + llvm::SmallVector<Symbol *> ivs; + int curLevel{0}; + const auto *loop{doConstruct}; + while (true) { + auto [iv, lb, ub, step] = GetLoopBounds(*loop); + + if (lb) + checkExprHasSymbols(ivs, lb); + if (ub) + checkExprHasSymbols(ivs, ub); + if (step) + checkExprHasSymbols(ivs, step); + if (iv) { + if (auto *symbol{currScope().FindSymbol(iv->source)}) + ivs.push_back(symbol); + } - // Stop after processing all affected loops - if (curLevel + 1 >= dirDepth) - break; + // Stop after processing all affected loops + if (curLevel + 1 >= dirDepth) + break; - // Recurse into nested loop - const auto &block{std::get<parser::Block>(loop->t)}; - if (block.empty()) { - // Insufficient number of nested loops already reported by - // CheckAssocLoopLevel() - break; - } + // Recurse into nested loop + const auto &block{std::get<parser::Block>(loop->t)}; + if (block.empty()) { + // Insufficient number of nested loops already reported by + // CheckAssocLoopLevel() + break; + } - loop = GetDoConstructIf(block.front()); - if (!loop) { - // Insufficient number of nested loops already reported by - // CheckAssocLoopLevel() - break; - } + loop = GetDoConstructIf(block.front()); + if (!loop) { + // Insufficient number of nested loops already reported by + // CheckAssocLoopLevel() + break; + } - auto checkPerfectNest = [&, this]() { - if (block.empty()) - return; - auto last = block.end(); - --last; + auto checkPerfectNest = [&, this]() { + if (block.empty()) + return; + auto last = block.end(); + --last; - // A trailing CONTINUE is not considered part of the loop body - if (parser::Unwrap<parser::ContinueStmt>(*last)) - --last; + // A trailing CONTINUE is not considered part of the loop body + if (parser::Unwrap<parser::ContinueStmt>(*last)) + --last; - // In a perfectly nested loop, the nested loop must be the only statement - if (last == block.begin()) - return; + // In a perfectly nested loop, the nested loop must be the only + // statement + if (last == block.begin()) + return; - // Non-perfectly nested loop - // TODO: Point to non-DO statement, directiveSource as a note - context_.Say(dirContext.directiveSource, - "Canonical loop nest must be perfectly nested."_err_en_US); - }; + // Non-perfectly nested loop + // TODO: Point to non-DO statement, directiveSource as a note + context_.Say(dirContext.directiveSource, + "Canonical loop nest must be perfectly nested."_err_en_US); + }; - checkPerfectNest(); + checkPerfectNest(); - ++curLevel; + ++curLevel; + } + } } } @@ -2379,7 +2362,6 @@ void OmpAttributeVisitor::CheckPerfectNestAndRectangularLoop( // construct with multiple associated do-loops are lastprivate. void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel( const parser::OpenMPLoopConstruct &x) { - unsigned version{context_.langOptions().OpenMPVersion}; std::int64_t level{GetContext().associatedLoopLevel}; if (level <= 0) { return; @@ -2398,22 +2380,13 @@ void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel( const parser::OmpClause *clause{GetAssociatedClause()}; bool hasCollapseClause{ clause ? (clause->Id() == llvm::omp::OMPC_collapse) : false}; - const parser::OpenMPLoopConstruct *innerMostLoop = &x; - const parser::NestedConstruct *innerMostNest = nullptr; - while (auto &optLoopCons{ - std::get<std::optional<parser::NestedConstruct>>(innerMostLoop->t)}) { - innerMostNest = &(optLoopCons.value()); - if (const auto *innerLoop{ - std::get_if<common::Indirection<parser::OpenMPLoopConstruct>>( - innerMostNest)}) { - innerMostLoop = &(innerLoop->value()); - } else - break; - } - if (innerMostNest) { - if (const auto &outer{std::get_if<parser::DoConstruct>(innerMostNest)}) { - for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; + for (auto &construct : std::get<parser::Block>(x.t)) { + if (const auto *innermostConstruct{parser::omp::GetOmpLoop(construct)}) { + PrivatizeAssociatedLoopIndexAndCheckLoopLevel(*innermostConstruct); + } else if (const auto *doConstruct{ + parser::omp::GetDoConstruct(construct)}) { + for (const parser::DoConstruct *loop{&*doConstruct}; loop && level > 0; --level) { if (loop->IsDoConcurrent()) { // DO CONCURRENT is explicitly allowed for the LOOP construct so long @@ -2446,28 +2419,6 @@ void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel( } } CheckAssocLoopLevel(level, GetAssociatedClause()); - } else if (const auto *loop{std::get_if< - common::Indirection<parser::OpenMPLoopConstruct>>( - innerMostNest)}) { - const parser::OmpDirectiveSpecification &beginSpec{ - loop->value().BeginDir()}; - const parser::OmpDirectiveName &beginName{beginSpec.DirName()}; - if (beginName.v != llvm::omp::Directive::OMPD_unroll && - beginName.v != llvm::omp::Directive::OMPD_tile) { - context_.Say(GetContext().directiveSource, - "Only UNROLL or TILE constructs are allowed between an OpenMP Loop Construct and a DO construct"_err_en_US, - parser::ToUpperCaseLetters(llvm::omp::getOpenMPDirectiveName( - GetContext().directive, version) - .str())); - } else { - PrivatizeAssociatedLoopIndexAndCheckLoopLevel(loop->value()); - } - } else { - context_.Say(GetContext().directiveSource, - "A DO loop must follow the %s directive"_err_en_US, - parser::ToUpperCaseLetters( - llvm::omp::getOpenMPDirectiveName(GetContext().directive, version) - .str())); } } } @@ -2526,7 +2477,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionConstruct &x) { bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { const parser::OmpBeginDirective &beginSpec{x.BeginDir()}; - PushContext(beginSpec.DirName().source, beginSpec.DirName().v); + PushContext(beginSpec.DirName().source, beginSpec.DirId()); GetContext().withinConstruct = true; return true; } @@ -2615,9 +2566,8 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) { PushContext(x.source, dirSpec.DirId()); for (const auto &clause : dirSpec.Clauses().v) { - if (const auto *allocClause{ - std::get_if<parser::OmpClause::Allocate>(&clause.u)}) { - ResolveOmpObjectList(std::get<parser::OmpObjectList>(allocClause->v.t), + if (std::get_if<parser::OmpClause::Allocate>(&clause.u)) { + ResolveOmpObjectList(*parser::omp::GetOmpObjectList(clause), Symbol::Flag::OmpExecutableAllocateDirective); } } @@ -2965,6 +2915,67 @@ void OmpAttributeVisitor::CreateImplicitSymbols(const Symbol *symbol) { } } +static bool IsOpenMPPointer(const Symbol &symbol) { + if (IsPointer(symbol) || IsBuiltinCPtr(symbol)) + return true; + return false; +} + +static bool IsOpenMPAggregate(const Symbol &symbol) { + if (IsAllocatable(symbol) || IsOpenMPPointer(symbol)) + return false; + + const auto *type{symbol.GetType()}; + // OpenMP categorizes Fortran characters as aggregates. + if (type->category() == Fortran::semantics::DeclTypeSpec::Category::Character) + return true; + + if (const auto *det{symbol.GetUltimate() + .detailsIf<Fortran::semantics::ObjectEntityDetails>()}) + if (det->IsArray()) + return true; + + if (type->AsDerived()) + return true; + + if (IsDeferredShape(symbol) || IsAssumedRank(symbol) || + IsAssumedShape(symbol)) + return true; + return false; +} + +static bool IsOpenMPScalar(const Symbol &symbol) { + if (IsOpenMPAggregate(symbol) || IsOpenMPPointer(symbol) || + IsAllocatable(symbol)) + return false; + const auto *type{symbol.GetType()}; + if ((!symbol.GetShape() || symbol.GetShape()->empty()) && + (type->category() == + Fortran::semantics::DeclTypeSpec::Category::Numeric || + type->category() == + Fortran::semantics::DeclTypeSpec::Category::Logical)) + return true; + return false; +} + +static bool DefaultMapCategoryMatchesSymbol( + parser::OmpVariableCategory::Value category, const Symbol &symbol) { + using VarCat = parser::OmpVariableCategory::Value; + switch (category) { + case VarCat::Scalar: + return IsOpenMPScalar(symbol); + case VarCat::Allocatable: + return IsAllocatable(symbol); + case VarCat::Aggregate: + return IsOpenMPAggregate(symbol); + case VarCat::Pointer: + return IsOpenMPPointer(symbol); + case VarCat::All: + return true; + } + return false; +} + // For OpenMP constructs, check all the data-refs within the constructs // and adjust the symbol for each Name if necessary void OmpAttributeVisitor::Post(const parser::Name &name) { @@ -3000,6 +3011,41 @@ void OmpAttributeVisitor::Post(const parser::Name &name) { } } + // TODO: handle case where default and defaultmap are present on the same + // construct and conflict, defaultmap should supersede default if they + // conflict. + if (!GetContext().defaultMap.empty()) { + // Checked before implicit data sharing attributes as this rule ignores + // them and expects explicit predetermined/specified attributes to be in + // place for the types specified. + if (Symbol * found{currScope().FindSymbol(name.source)}) { + // If the variable has declare target applied to it (enter or link) it + // is exempt from defaultmap(none) restrictions. + // We also exempt procedures and named constants from defaultmap(none) + // checking. + if (!symbol->GetUltimate().test(Symbol::Flag::OmpDeclareTarget) && + !(IsProcedure(*symbol) && + !semantics::IsProcedurePointer(*symbol)) && + !IsNamedConstant(*symbol)) { + auto &dMap = GetContext().defaultMap; + for (auto defaults : dMap) { + if (defaults.second == + parser::OmpDefaultmapClause::ImplicitBehavior::None) { + if (DefaultMapCategoryMatchesSymbol(defaults.first, *found)) { + if (!IsObjectWithDSA(*symbol)) { + context_.Say(name.source, + "The DEFAULTMAP(NONE) clause requires that '%s' must be " + "listed in a " + "data-sharing attribute, data-mapping attribute, or is_device_ptr clause"_err_en_US, + symbol->name()); + } + } + } + } + } + } + } + if (Symbol * found{currScope().FindSymbol(name.source)}) { if (found->GetUltimate().test(semantics::Symbol::Flag::OmpThreadprivate)) return; @@ -3578,8 +3624,8 @@ void OmpAttributeVisitor::IssueNonConformanceWarning(llvm::omp::Directive D, case llvm::omp::OMPD_allocate: setAlternativeStr("ALLOCATORS"); break; - case llvm::omp::OMPD_target_loop: - default:; + default: + break; } context_.Warn(common::UsageWarning::OpenMPUsage, source, "%s"_warn_en_US, warnStrOS.str()); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index a2062ef..345a0e4 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1852,21 +1852,25 @@ bool OmpVisitor::Pre(const parser::OmpMapClause &x) { // TODO: Do we need a specific flag or type here, to distinghuish against // other ConstructName things? Leaving this for the full implementation // of mapper lowering. - auto *misc{symbol->detailsIf<MiscDetails>()}; - if (!misc || misc->kind() != MiscDetails::Kind::ConstructName) + auto &ultimate{symbol->GetUltimate()}; + auto *misc{ultimate.detailsIf<MiscDetails>()}; + auto *md{ultimate.detailsIf<MapperDetails>()}; + if (!md && (!misc || misc->kind() != MiscDetails::Kind::ConstructName)) context().Say(mapper->v.source, "Name '%s' should be a mapper name"_err_en_US, mapper->v.source); else mapper->v.symbol = symbol; } else { - mapper->v.symbol = - &MakeSymbol(mapper->v, MiscDetails{MiscDetails::Kind::ConstructName}); - // TODO: When completing the implementation, we probably want to error if - // the symbol is not declared, but right now, testing that the TODO for - // OmpMapClause happens is obscured by the TODO for declare mapper, so - // leaving this out. Remove the above line once the declare mapper is - // implemented. context().Say(mapper->v.source, "'%s' not - // declared"_err_en_US, mapper->v.source); + // Allow the special 'default' mapper identifier without prior + // declaration so lowering can recognize and handle it. Emit an + // error for any other missing mapper identifier. + if (mapper->v.source.ToString() == "default") { + mapper->v.symbol = &MakeSymbol( + mapper->v, MiscDetails{MiscDetails::Kind::ConstructName}); + } else { + context().Say( + mapper->v.source, "'%s' not declared"_err_en_US, mapper->v.source); + } } } return true; @@ -1880,8 +1884,16 @@ void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec, // the type has been fully processed. BeginDeclTypeSpec(); auto &mapperName{std::get<std::string>(spec.t)}; - MakeSymbol(parser::CharBlock(mapperName), Attrs{}, - MiscDetails{MiscDetails::Kind::ConstructName}); + // Create or update the mapper symbol with MapperDetails and + // keep track of the declarative construct for module emission. + SourceName mapperSource{context().SaveTempName(std::string{mapperName})}; + Symbol &mapperSym{MakeSymbol(mapperSource, Attrs{})}; + if (!mapperSym.detailsIf<MapperDetails>()) { + mapperSym.set_details(MapperDetails{}); + } + if (!context().langOptions().OpenMPSimd) { + mapperSym.get<MapperDetails>().AddDecl(declaratives_.back()); + } PushScope(Scope::Kind::OtherConstruct, nullptr); Walk(std::get<parser::TypeSpec>(spec.t)); auto &varName{std::get<parser::Name>(spec.t)}; @@ -2141,6 +2153,8 @@ public: void Post(const parser::AssignedGotoStmt &); void Post(const parser::CompilerDirective &); + bool Pre(const parser::SectionSubscript &); + // These nodes should never be reached: they are handled in ProgramUnit bool Pre(const parser::MainProgram &) { llvm_unreachable("This node is handled in ProgramUnit"); @@ -3611,10 +3625,20 @@ void ModuleVisitor::Post(const parser::UseStmt &x) { rename.u); } for (const auto &[name, symbol] : *useModuleScope_) { + // Default USE imports public names, excluding intrinsic-only and most + // miscellaneous details. Allow OpenMP mapper identifiers represented + // as MapperDetails, and also legacy MiscDetails::ConstructName. + bool isMapper{symbol->has<MapperDetails>()}; + if (!isMapper) { + if (const auto *misc{symbol->detailsIf<MiscDetails>()}) { + isMapper = misc->kind() == MiscDetails::Kind::ConstructName; + } + } if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) && (!symbol->implicitAttrs().test(Attr::INTRINSIC) || symbol->has<UseDetails>()) && - !symbol->has<MiscDetails>() && useNames.count(name) == 0) { + (!symbol->has<MiscDetails>() || isMapper) && + useNames.count(name) == 0) { SourceName location{x.moduleName.source}; if (auto *localSymbol{FindInScope(name)}) { DoAddUse(location, localSymbol->name(), *localSymbol, *symbol); @@ -3945,22 +3969,6 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, useProcedure = &useUltimate; } - // Creates a UseErrorDetails symbol in the current scope for a - // current UseDetails symbol, but leaves the UseDetails in the - // scope's name map. - auto CreateLocalUseError{[&]() { - EraseSymbol(*localSymbol); - CHECK(localSymbol->has<UseDetails>()); - UseErrorDetails details{localSymbol->get<UseDetails>()}; - details.add_occurrence(location, useSymbol); - Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))}; - // Restore *localSymbol in currScope - auto iter{currScope().find(localName)}; - CHECK(iter != currScope().end() && &*iter->second == newSymbol); - iter->second = MutableSymbolRef{*localSymbol}; - return newSymbol; - }}; - // When two derived types arrived, try to combine them. const Symbol *combinedDerivedType{nullptr}; if (!useDerivedType) { @@ -3986,8 +3994,19 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, combinedDerivedType = localDerivedType; } else { // Create a local UseErrorDetails for the ambiguous derived type - if (localGeneric) { - combinedDerivedType = CreateLocalUseError(); + if (localSymbol->has<UseDetails>() && localGeneric) { + // Creates a UseErrorDetails symbol in the current scope for a + // current UseDetails symbol, but leaves the UseDetails in the + // scope's name map. + UseErrorDetails details{localSymbol->get<UseDetails>()}; + EraseSymbol(*localSymbol); + details.add_occurrence(location, useSymbol); + Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))}; + // Restore *localSymbol in currScope + auto iter{currScope().find(localName)}; + CHECK(iter != currScope().end() && &*iter->second == newSymbol); + iter->second = MutableSymbolRef{*localSymbol}; + combinedDerivedType = newSymbol; } else { ConvertToUseError(*localSymbol, location, useSymbol); localDerivedType = nullptr; @@ -10058,6 +10077,7 @@ void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) { void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) { if (std::holds_alternative<parser::CompilerDirective::VectorAlways>(x.u) || + std::holds_alternative<parser::CompilerDirective::VectorLength>(x.u) || std::holds_alternative<parser::CompilerDirective::Unroll>(x.u) || std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(x.u) || std::holds_alternative<parser::CompilerDirective::NoVector>(x.u) || @@ -10065,7 +10085,9 @@ void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) { std::holds_alternative<parser::CompilerDirective::NoUnrollAndJam>(x.u) || std::holds_alternative<parser::CompilerDirective::ForceInline>(x.u) || std::holds_alternative<parser::CompilerDirective::Inline>(x.u) || - std::holds_alternative<parser::CompilerDirective::NoInline>(x.u)) { + std::holds_alternative<parser::CompilerDirective::Prefetch>(x.u) || + std::holds_alternative<parser::CompilerDirective::NoInline>(x.u) || + std::holds_alternative<parser::CompilerDirective::IVDep>(x.u)) { return; } if (const auto *tkr{ @@ -10198,6 +10220,14 @@ template <typename A> std::set<SourceName> GetUses(const A &x) { return uses; } +bool ResolveNamesVisitor::Pre(const parser::SectionSubscript &x) { + // Turn off "in EQUIVALENCE" check for array indexing, because + // the indices themselves are not part of the EQUIVALENCE. + auto restorer{common::ScopedSet(inEquivalenceStmt_, false)}; + Walk(x.u); + return false; +} + bool ResolveNamesVisitor::Pre(const parser::Program &x) { if (Scope * hermetic{context().currentHermeticModuleFileScope()}) { // Processing either the dependent modules or first module of a diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp index 5b7dab3..60e3e6a 100644 --- a/flang/lib/Semantics/rewrite-parse-tree.cpp +++ b/flang/lib/Semantics/rewrite-parse-tree.cpp @@ -9,6 +9,7 @@ #include "rewrite-parse-tree.h" #include "flang/Common/indirection.h" +#include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree-visitor.h" #include "flang/Parser/parse-tree.h" #include "flang/Parser/tools.h" @@ -117,7 +118,7 @@ static bool ReturnsDataPointer(const Symbol &symbol) { } static bool LoopConstructIsSIMD(parser::OpenMPLoopConstruct *ompLoop) { - return llvm::omp::allSimdSet.test(ompLoop->BeginDir().DirName().v); + return llvm::omp::allSimdSet.test(ompLoop->BeginDir().DirId()); } // Remove non-SIMD OpenMPConstructs once they are parsed. @@ -195,20 +196,24 @@ void RewriteMutator::OpenMPSimdOnly( ++it; continue; } - auto &nest = - std::get<std::optional<parser::NestedConstruct>>(ompLoop->t); - - if (auto *doConstruct = - std::get_if<parser::DoConstruct>(&nest.value())) { - auto &loopBody = std::get<parser::Block>(doConstruct->t); - // We can only remove some constructs from a loop when it's _not_ a - // OpenMP simd loop - OpenMPSimdOnly(loopBody, /*isNonSimdLoopBody=*/true); - auto newDoConstruct = std::move(*doConstruct); - auto newLoop = parser::ExecutionPartConstruct{ - parser::ExecutableConstruct{std::move(newDoConstruct)}}; + std::list<parser::ExecutionPartConstruct> doList; + for (auto &construct : std::get<parser::Block>(ompLoop->t)) { + if (auto *doConstruct = const_cast<parser::DoConstruct *>( + parser::omp::GetDoConstruct(construct))) { + auto &loopBody = std::get<parser::Block>(doConstruct->t); + // We can only remove some constructs from a loop when it's _not_ + // a OpenMP simd loop + OpenMPSimdOnly(const_cast<parser::Block &>(loopBody), + /*isNonSimdLoopBody=*/true); + auto newLoop = parser::ExecutionPartConstruct{ + parser::ExecutableConstruct{std::move(*doConstruct)}}; + doList.insert(doList.end(), std::move(newLoop)); + } + } + if (!doList.empty()) { it = block.erase(it); - block.insert(it, std::move(newLoop)); + for (auto &newLoop : doList) + block.insert(it, std::move(newLoop)); continue; } } else if (auto *ompCon{std::get_if<parser::OpenMPSectionsConstruct>( @@ -386,13 +391,12 @@ bool RewriteMutator::Pre(parser::OpenMPLoopConstruct &ompLoop) { // If we're looking at a non-simd OpenMP loop, we need to explicitly // call OpenMPSimdOnly on the nested loop block while indicating where // the block comes from. - auto &nest = std::get<std::optional<parser::NestedConstruct>>(ompLoop.t); - if (!nest.has_value()) { - return true; - } - if (auto *doConstruct = std::get_if<parser::DoConstruct>(&*nest)) { - auto &innerBlock = std::get<parser::Block>(doConstruct->t); - OpenMPSimdOnly(innerBlock, /*isNonSimdLoopBody=*/true); + for (auto &construct : std::get<parser::Block>(ompLoop.t)) { + if (auto *doConstruct = parser::omp::GetDoConstruct(construct)) { + auto &innerBlock = std::get<parser::Block>(doConstruct->t); + OpenMPSimdOnly(const_cast<parser::Block &>(innerBlock), + /*isNonSimdLoopBody=*/true); + } } } return true; diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index 0ec44b7..ed0715a 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -338,7 +338,8 @@ std::string DetailsToString(const Details &details) { [](const TypeParamDetails &) { return "TypeParam"; }, [](const MiscDetails &) { return "Misc"; }, [](const AssocEntityDetails &) { return "AssocEntity"; }, - [](const UserReductionDetails &) { return "UserReductionDetails"; }}, + [](const UserReductionDetails &) { return "UserReductionDetails"; }, + [](const MapperDetails &) { return "MapperDetails"; }}, details); } @@ -379,6 +380,7 @@ bool Symbol::CanReplaceDetails(const Details &details) const { [&](const UserReductionDetails &) { return has<UserReductionDetails>(); }, + [&](const MapperDetails &) { return has<MapperDetails>(); }, [](const auto &) { return false; }, }, details); @@ -685,6 +687,8 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { DumpType(os, type); } }, + // Avoid recursive streaming for MapperDetails; nothing more to dump + [&](const MapperDetails &) {}, [&](const auto &x) { os << x; }, }, details); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 8eddd03..cf1e5e7 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -582,6 +582,18 @@ bool IsOrContainsEventOrLockComponent(const Symbol &original) { return false; } +bool IsOrContainsNotifyComponent(const Symbol &original) { + const Symbol &symbol{ResolveAssociations(original, /*stopAtTypeGuard=*/true)}; + if (evaluate::IsVariable(symbol)) { + if (const DeclTypeSpec *type{symbol.GetType()}) { + if (const DerivedTypeSpec *derived{type->AsDerived()}) { + return IsNotifyType(derived) || FindNotifyPotentialComponent(*derived); + } + } + } + return false; +} + // Check this symbol suitable as a type-bound procedure - C769 bool CanBeTypeBoundProc(const Symbol &symbol) { if (IsDummy(symbol) || IsProcedurePointer(symbol)) { @@ -1489,6 +1501,32 @@ PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent( return iter; } +PotentialComponentIterator::const_iterator FindNotifyPotentialComponent( + const DerivedTypeSpec &derived, bool ignoreCoarrays) { + PotentialComponentIterator potentials{derived}; + auto iter{potentials.begin()}; + for (auto end{potentials.end()}; iter != end; ++iter) { + const Symbol &component{*iter}; + if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) { + if (const DeclTypeSpec *type{object->type()}) { + if (IsNotifyType(type->AsDerived())) { + if (!ignoreCoarrays) { + break; // found one + } + auto path{iter.GetComponentPath()}; + path.pop_back(); + if (std::find_if(path.begin(), path.end(), [](const Symbol &sym) { + return evaluate::IsCoarray(sym); + }) == path.end()) { + break; // found one not in a coarray + } + } + } + } + } + return iter; +} + UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent( const DerivedTypeSpec &derived) { UltimateComponentIterator ultimates{derived}; diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index dba15e6..038a402 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -192,6 +192,13 @@ void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) { } } +void DerivedTypeSpec::ReevaluateParameters(SemanticsContext &context) { + evaluated_ = false; + instantiated_ = false; + scope_ = nullptr; + EvaluateParameters(context); +} + void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) { CHECK(cooked_); auto pair{parameters_.insert(std::make_pair(name, std::move(value)))}; |