#include "resolve-names.h"
#include "assignment.h"
+#include "check-omp-structure.h"
#include "mod-file.h"
#include "program-tree.h"
#include "resolve-names-utils.h"
template<typename T> bool Pre(const parser::Statement<T> &x) {
messageHandler().set_currStmtSource(x.source);
- for (auto *scope = currScope_; scope; scope = &scope->parent()) {
- scope->AddSourceRange(x.source);
- if (scope->IsGlobal()) {
- break;
- }
- }
+ currScope_->AddSourceRange(x.source);
return true;
}
template<typename T> void Post(const parser::Statement<T> &) {
void CheckExplicitInterface(const parser::Name &);
void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
+ const parser::Name *ResolveDesignator(const parser::Designator &);
+
protected:
bool BeginDecl();
void EndDecl();
// or nullptr in case of error.
const parser::Name *ResolveStructureComponent(
const parser::StructureComponent &);
- const parser::Name *ResolveDesignator(const parser::Designator &);
const parser::Name *ResolveDataRef(const parser::DataRef &);
const parser::Name *ResolveVariable(const parser::Variable &);
const parser::Name *ResolveName(const parser::Name &);
void PopAssociation();
};
-// Resolve OpenMP construct entities and statement (TODO) entities
+// Create scopes for OpenMP constructs
class OmpVisitor : public virtual DeclarationVisitor {
public:
- static const parser::Name *GetDesignatorNameIfDataRef(
- const parser::Designator &designator) {
- const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
- return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
- }
+ void AddOmpSourceRange(const parser::CharBlock &);
- bool Pre(const parser::OpenMPBlockConstruct &) {
- PushScope(Scope::Kind::Block, nullptr);
+ static bool NeedsScope(const parser::OpenMPBlockConstruct &);
+
+ bool Pre(const parser::OpenMPBlockConstruct &);
+ void Post(const parser::OpenMPBlockConstruct &);
+ bool Pre(const parser::OmpBeginBlockDirective &x) {
+ AddOmpSourceRange(x.source);
return true;
}
- void Post(const parser::OpenMPBlockConstruct &) { PopScope(); }
- bool Pre(const parser::OmpBeginBlockDirective &) {
- ClearDataSharingAttributeObjects();
+ void Post(const parser::OmpBeginBlockDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
+ bool Pre(const parser::OmpEndBlockDirective &x) {
+ AddOmpSourceRange(x.source);
return true;
}
+ void Post(const parser::OmpEndBlockDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
bool Pre(const parser::OpenMPLoopConstruct &) {
PushScope(Scope::Kind::Block, nullptr);
return true;
}
void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
- bool Pre(const parser::OmpBeginLoopDirective &) {
- ClearDataSharingAttributeObjects();
+ bool Pre(const parser::OmpBeginLoopDirective &x) {
+ AddOmpSourceRange(x.source);
+ return true;
+ }
+ void Post(const parser::OmpBeginLoopDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
+ bool Pre(const parser::OmpEndLoopDirective &x) {
+ AddOmpSourceRange(x.source);
+ return true;
+ }
+ void Post(const parser::OmpEndLoopDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
+
+ bool Pre(const parser::OpenMPSectionsConstruct &) {
+ PushScope(Scope::Kind::Block, nullptr);
+ return true;
+ }
+ void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
+ bool Pre(const parser::OmpBeginSectionsDirective &x) {
+ AddOmpSourceRange(x.source);
+ return true;
+ }
+ void Post(const parser::OmpBeginSectionsDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
+ bool Pre(const parser::OmpEndSectionsDirective &x) {
+ AddOmpSourceRange(x.source);
return true;
}
+ void Post(const parser::OmpEndSectionsDirective &) {
+ messageHandler().set_currStmtSource(std::nullopt);
+ }
+};
+
+bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
+ const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+ switch (beginDir.v) {
+ case parser::OmpBlockDirective::Directive::TargetData:
+ case parser::OmpBlockDirective::Directive::Master:
+ case parser::OmpBlockDirective::Directive::Ordered: return false;
+ default: return true;
+ }
+}
- bool Pre(const parser::OpenMPThreadprivate &x) {
+void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
+ messageHandler().set_currStmtSource(source);
+ currScope().AddSourceRange(source);
+}
+
+bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
+ if (NeedsScope(x)) {
PushScope(Scope::Kind::Block, nullptr);
- const auto &list{std::get<parser::OmpObjectList>(x.t)};
- ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
+ }
+ return true;
+}
+
+void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
+ if (NeedsScope(x)) {
PopScope();
- return false;
}
+}
+
+// Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
+class OmpAttributeVisitor {
+public:
+ explicit OmpAttributeVisitor(
+ SemanticsContext &context, ResolveNamesVisitor &resolver)
+ : context_{context}, resolver_{resolver} {}
+
+ template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
+
+ template<typename A> bool Pre(const A &) { return true; }
+ template<typename A> void Post(const A &) {}
+
+ bool Pre(const parser::OpenMPBlockConstruct &);
+ void Post(const parser::OpenMPBlockConstruct &) { PopContext(); }
+ void Post(const parser::OmpBeginBlockDirective &) {
+ GetContext().withinConstruct = true;
+ }
+
+ bool Pre(const parser::OpenMPLoopConstruct &);
+ void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
+ void Post(const parser::OmpBeginLoopDirective &) {
+ GetContext().withinConstruct = true;
+ }
+
+ bool Pre(const parser::OpenMPSectionsConstruct &);
+ void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
+
+ bool Pre(const parser::OpenMPThreadprivate &);
+ void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
+ // 2.15.3 Data-Sharing Attribute Clauses
+ void Post(const parser::OmpDefaultClause &);
bool Pre(const parser::OmpClause::Shared &x) {
ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
return false;
return false;
}
+ void Post(const parser::Name &);
+
private:
+ struct OmpContext {
+ OmpContext(const parser::CharBlock &source, OmpDirective d, Scope &s)
+ : directiveSource{source}, directive{d}, scope{s} {}
+ parser::CharBlock directiveSource;
+ OmpDirective directive;
+ Scope &scope;
+ // TODO: default DSA is implicitly determined in different ways
+ Symbol::Flag defaultDSA{Symbol::Flag::OmpShared};
+ // variables on Data-sharing attribute clauses
+ std::map<const Symbol *, Symbol::Flag> objectWithDSA;
+ bool withinConstruct{false};
+ };
+ // back() is the top of the stack
+ OmpContext &GetContext() {
+ CHECK(!ompContext_.empty());
+ return ompContext_.back();
+ }
+ void PushContext(const parser::CharBlock &source, OmpDirective dir) {
+ ompContext_.emplace_back(source, dir, context_.FindScope(source));
+ }
+ void PopContext() { ompContext_.pop_back(); }
+ void SetContextDirectiveSource(parser::CharBlock &dir) {
+ GetContext().directiveSource = dir;
+ }
+ void SetContextDirectiveEnum(OmpDirective dir) {
+ GetContext().directive = dir;
+ }
+ const Scope &currScope() { return GetContext().scope; }
+ void SetContextDefaultDSA(Symbol::Flag flag) {
+ GetContext().defaultDSA = flag;
+ }
+ void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
+ GetContext().objectWithDSA.emplace(&symbol, flag);
+ }
+ bool IsObjectWithDSA(const Symbol &symbol) {
+ auto it{GetContext().objectWithDSA.find(&symbol)};
+ return it != GetContext().objectWithDSA.end();
+ }
+
+ Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
+ const auto pair{
+ GetContext().scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
+ return *pair.first->second;
+ }
+
+ static const parser::Name *GetDesignatorNameIfDataRef(
+ const parser::Designator &designator) {
+ const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
+ return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
+ }
+
static constexpr Symbol::Flags dataSharingAttributeFlags{
Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
}
bool HasDataSharingAttributeObject(const Symbol &);
- // TODO: resolve variables referenced in the OpenMP region
void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
- Symbol &ResolveOmp(const parser::Name &, Symbol::Flag);
- Symbol &ResolveOmp(Symbol &, Symbol::Flag);
+ Symbol *ResolveOmp(const parser::Name &, Symbol::Flag);
+ Symbol *ResolveOmp(Symbol &, Symbol::Flag);
Symbol *ResolveOmpCommonBlockName(const parser::Name *);
- Symbol &DeclarePrivateAccessEntity(const parser::Name &, Symbol::Flag);
- Symbol &DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
- Symbol &DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
- Symbol &DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
+ Symbol *DeclarePrivateAccessEntity(const parser::Name &, Symbol::Flag);
+ Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
+ Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
+ Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
void CheckMultipleAppearances(
const parser::Name &, const Symbol &, Symbol::Flag);
-
SymbolSet dataSharingAttributeObjects_; // on one directive
-};
-
-bool OmpVisitor::HasDataSharingAttributeObject(const Symbol &object) {
- auto it{dataSharingAttributeObjects_.find(object)};
- return it != dataSharingAttributeObjects_.end();
-}
-
-Symbol *OmpVisitor::ResolveOmpCommonBlockName(const parser::Name *name) {
- if (auto *prev{name ? currScope().parent().FindCommonBlock(name->source)
- : nullptr}) {
- name->symbol = prev;
- return prev;
- } else {
- return nullptr;
- }
-}
-void OmpVisitor::ResolveOmpObjectList(
- const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
- for (const auto &ompObject : ompObjectList.v) {
- ResolveOmpObject(ompObject, ompFlag);
- }
-}
-
-void OmpVisitor::ResolveOmpObject(
- const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
- std::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
- auto &symbol{ResolveOmp(*name, ompFlag)};
- if (dataSharingAttributeFlags.test(ompFlag)) {
- CheckMultipleAppearances(*name, symbol, ompFlag);
- }
- } else if (const auto *name{ResolveDesignator(designator)};
- name && name->symbol) {
- // Array sections to be changed to substrings as needed
- if (AnalyzeExpr(context(), designator)) {
- if (std::holds_alternative<parser::Substring>(designator.u)) {
- Say(designator.source,
- "Substrings are not allowed on OpenMP "
- "directives or clauses"_err_en_US);
- return;
- }
- }
- // other checks, more TBD
- if (const auto *details{
- name->symbol->detailsIf<ObjectEntityDetails>()}) {
- if (details->IsArray()) {
- // TODO: check Array Sections
- } else if (name->symbol->owner().IsDerivedType()) {
- // TODO: check Structure Component
- }
- }
- }
- },
- [&](const parser::Name &name) { // common block
- if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
- CheckMultipleAppearances(
- name, *symbol, Symbol::Flag::OmpCommonBlock);
- // 2.15.3 When a named common block appears in a list, it has the
- // same meaning as if every explicit member of the common block
- // appeared in the list
- for (const Symbol &object :
- symbol->get<CommonBlockDetails>().objects()) {
- Symbol &mutableObject{const_cast<Symbol &>(object)};
- ResolveOmp(mutableObject, ompFlag);
- }
- } else {
- Say(name.source, // 2.15.3
- "COMMON block must be declared in the same scoping unit "
- "in which the OpenMP directive or clause appears"_err_en_US);
- }
- },
- },
- ompObject.u);
-}
-
-Symbol &OmpVisitor::ResolveOmp(const parser::Name &name, Symbol::Flag ompFlag) {
- if (ompFlagsRequireNewSymbol.test(ompFlag)) {
- return DeclarePrivateAccessEntity(name, ompFlag);
- } else {
- return DeclareOrMarkOtherAccessEntity(name, ompFlag);
- }
-}
-
-Symbol &OmpVisitor::ResolveOmp(Symbol &symbol, Symbol::Flag ompFlag) {
- if (ompFlagsRequireNewSymbol.test(ompFlag)) {
- return DeclarePrivateAccessEntity(symbol, ompFlag);
- } else {
- return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
- }
-}
-
-Symbol &OmpVisitor::DeclarePrivateAccessEntity(
- const parser::Name &name, Symbol::Flag ompFlag) {
- Symbol &prev{FindOrDeclareEnclosingEntity(name)};
- if (prev.owner() != currScope()) {
- auto &symbol{MakeSymbol(name, HostAssocDetails{prev})};
- symbol.set(ompFlag);
- name.symbol = &symbol; // override resolution to parent
- return symbol;
- } else {
- prev.set(ompFlag);
- return prev;
- }
-}
-
-Symbol &OmpVisitor::DeclarePrivateAccessEntity(
- Symbol &object, Symbol::Flag ompFlag) {
- if (object.owner() != currScope() &&
- !FindInScope(currScope(), object.name())) {
- auto &symbol{MakeSymbol(object.name(), Attrs{}, HostAssocDetails{object})};
- symbol.set(ompFlag);
- return symbol;
- } else {
- object.set(ompFlag);
- return object;
- }
-}
-
-Symbol &OmpVisitor::DeclareOrMarkOtherAccessEntity(
- const parser::Name &name, Symbol::Flag ompFlag) {
- Symbol &prev{FindOrDeclareEnclosingEntity(name)};
- name.symbol = &prev;
- if (ompFlagsRequireMark.test(ompFlag)) {
- prev.set(ompFlag);
- }
- return prev;
-}
-
-Symbol &OmpVisitor::DeclareOrMarkOtherAccessEntity(
- Symbol &object, Symbol::Flag ompFlag) {
- if (ompFlagsRequireMark.test(ompFlag)) {
- object.set(ompFlag);
- }
- return object;
-}
-
-static bool WithMultipleAppearancesException(
- const Symbol &symbol, Symbol::Flag ompFlag) {
- return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
- symbol.test(Symbol::Flag::OmpLastPrivate)) ||
- (ompFlag == Symbol::Flag::OmpLastPrivate &&
- symbol.test(Symbol::Flag::OmpFirstPrivate));
-}
-
-void OmpVisitor::CheckMultipleAppearances(
- const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
- const auto *target{&symbol};
- if (ompFlagsRequireNewSymbol.test(ompFlag)) {
- if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
- target = &details->symbol();
- }
- }
- if (HasDataSharingAttributeObject(*target) &&
- !WithMultipleAppearancesException(symbol, ompFlag)) {
- Say(name.source,
- "'%s' appears in more than one data-sharing clause "
- "on the same OpenMP directive"_err_en_US,
- name.ToString());
- } else {
- AddDataSharingAttributeObject(*target);
- }
-}
+ SemanticsContext &context_;
+ ResolveNamesVisitor &resolver_;
+ std::vector<OmpContext> ompContext_; // used as a stack
+};
// Walk the parse tree and resolve names to symbols.
class ResolveNamesVisitor : public virtual ScopeHandler,
ResolveSpecificationParts(root);
FinishSpecificationParts(root);
ResolveExecutionParts(root);
+ OmpAttributeVisitor{context(), *this}.Walk(x);
return false;
}
bool pushedScope_{false};
};
+bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
+ const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+ switch (beginDir.v) {
+ case parser::OmpBlockDirective::Directive::Master:
+ PushContext(beginDir.source, OmpDirective::MASTER);
+ break;
+ case parser::OmpBlockDirective::Directive::Ordered:
+ PushContext(beginDir.source, OmpDirective::ORDERED);
+ break;
+ case parser::OmpBlockDirective::Directive::Parallel:
+ PushContext(beginDir.source, OmpDirective::PARALLEL);
+ break;
+ case parser::OmpBlockDirective::Directive::Single:
+ PushContext(beginDir.source, OmpDirective::SINGLE);
+ break;
+ case parser::OmpBlockDirective::Directive::Target:
+ PushContext(beginDir.source, OmpDirective::TARGET);
+ break;
+ case parser::OmpBlockDirective::Directive::TargetData:
+ PushContext(beginDir.source, OmpDirective::TARGET_DATA);
+ break;
+ case parser::OmpBlockDirective::Directive::Task:
+ PushContext(beginDir.source, OmpDirective::TASK);
+ break;
+ case parser::OmpBlockDirective::Directive::Teams:
+ PushContext(beginDir.source, OmpDirective::TEAMS);
+ break;
+ case parser::OmpBlockDirective::Directive::Workshare:
+ PushContext(beginDir.source, OmpDirective::WORKSHARE);
+ break;
+ default:
+ // TODO others
+ break;
+ }
+ ClearDataSharingAttributeObjects();
+ return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
+ const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+ const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+ switch (beginDir.v) {
+ case parser::OmpLoopDirective::Directive::Distribute:
+ PushContext(beginDir.source, OmpDirective::DISTRIBUTE);
+ break;
+ case parser::OmpLoopDirective::Directive::Do:
+ PushContext(beginDir.source, OmpDirective::DO);
+ break;
+ case parser::OmpLoopDirective::Directive::DoSimd:
+ PushContext(beginDir.source, OmpDirective::DO_SIMD);
+ break;
+ case parser::OmpLoopDirective::Directive::ParallelDo:
+ PushContext(beginDir.source, OmpDirective::PARALLEL_DO);
+ break;
+ case parser::OmpLoopDirective::Directive::ParallelDoSimd:
+ PushContext(beginDir.source, OmpDirective::PARALLEL_DO_SIMD);
+ break;
+ case parser::OmpLoopDirective::Directive::Simd:
+ PushContext(beginDir.source, OmpDirective::SIMD);
+ break;
+ case parser::OmpLoopDirective::Directive::Taskloop:
+ PushContext(beginDir.source, OmpDirective::TASKLOOP);
+ break;
+ case parser::OmpLoopDirective::Directive::TaskloopSimd:
+ PushContext(beginDir.source, OmpDirective::TASKLOOP_SIMD);
+ break;
+ default:
+ // TODO others
+ break;
+ }
+ ClearDataSharingAttributeObjects();
+ return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
+ const auto &beginSectionsDir{
+ std::get<parser::OmpBeginSectionsDirective>(x.t)};
+ const auto &beginDir{
+ std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
+ switch (beginDir.v) {
+ case parser::OmpSectionsDirective::Directive::ParallelSections:
+ PushContext(beginDir.source, OmpDirective::PARALLEL_SECTIONS);
+ break;
+ case parser::OmpSectionsDirective::Directive::Sections:
+ PushContext(beginDir.source, OmpDirective::SECTIONS);
+ break;
+ default: break;
+ }
+ ClearDataSharingAttributeObjects();
+ return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
+ PushContext(x.source, OmpDirective::THREADPRIVATE);
+ const auto &list{std::get<parser::OmpObjectList>(x.t)};
+ ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
+ return false;
+}
+
+void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
+ if (!ompContext_.empty()) {
+ switch (x.v) {
+ case parser::OmpDefaultClause::Type::Private:
+ SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
+ break;
+ case parser::OmpDefaultClause::Type::Firstprivate:
+ SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
+ break;
+ case parser::OmpDefaultClause::Type::Shared:
+ SetContextDefaultDSA(Symbol::Flag::OmpShared);
+ break;
+ case parser::OmpDefaultClause::Type::None:
+ SetContextDefaultDSA(Symbol::Flag::OmpNone);
+ break;
+ }
+ }
+}
+
+// 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) {
+ auto *symbol{name.symbol};
+ if (symbol && !ompContext_.empty() && GetContext().withinConstruct) {
+ if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
+ !IsObjectWithDSA(*symbol)) {
+ // TODO: create a separate function to go through the rules for
+ // predetermined, explicitly determined, and implicitly
+ // determined data-sharing attributes (2.15.1.1).
+ if (Symbol * found{currScope().FindSymbol(name.source)}) {
+ if (IsObjectWithDSA(*found)) {
+ name.symbol = found; // adjust the symbol within region
+ } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
+ context_.Say(name.source,
+ "The DEFAULT(NONE) clause requires that '%s' must be listed in "
+ "a data-sharing attribute clause"_err_en_US,
+ symbol->name());
+ }
+ }
+ }
+ } // within OpenMP construct
+}
+
+bool OmpAttributeVisitor::HasDataSharingAttributeObject(const Symbol &object) {
+ auto it{dataSharingAttributeObjects_.find(object)};
+ return it != dataSharingAttributeObjects_.end();
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
+ const parser::Name *name) {
+ if (auto *prev{name
+ ? GetContext().scope.parent().FindCommonBlock(name->source)
+ : nullptr}) {
+ name->symbol = prev;
+ return prev;
+ } else {
+ return nullptr;
+ }
+}
+
+void OmpAttributeVisitor::ResolveOmpObjectList(
+ const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
+ for (const auto &ompObject : ompObjectList.v) {
+ ResolveOmpObject(ompObject, ompFlag);
+ }
+}
+
+void OmpAttributeVisitor::ResolveOmpObject(
+ const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
+ std::visit(
+ common::visitors{
+ [&](const parser::Designator &designator) {
+ if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
+ if (auto *symbol{ResolveOmp(*name, ompFlag)}) {
+ AddToContextObjectWithDSA(*symbol, ompFlag);
+ if (dataSharingAttributeFlags.test(ompFlag)) {
+ CheckMultipleAppearances(*name, *symbol, ompFlag);
+ }
+ }
+ } else if (const auto *designatorName{
+ resolver_.ResolveDesignator(designator)};
+ designatorName->symbol) {
+ // Array sections to be changed to substrings as needed
+ if (AnalyzeExpr(context_, designator)) {
+ if (std::holds_alternative<parser::Substring>(designator.u)) {
+ context_.Say(designator.source,
+ "Substrings are not allowed on OpenMP "
+ "directives or clauses"_err_en_US);
+ }
+ }
+ // other checks, more TBD
+ if (const auto *details{designatorName->symbol
+ ->detailsIf<ObjectEntityDetails>()}) {
+ if (details->IsArray()) {
+ // TODO: check Array Sections
+ } else if (designatorName->symbol->owner().IsDerivedType()) {
+ // TODO: check Structure Component
+ }
+ }
+ }
+ },
+ [&](const parser::Name &name) { // common block
+ if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
+ CheckMultipleAppearances(
+ name, *symbol, Symbol::Flag::OmpCommonBlock);
+ // 2.15.3 When a named common block appears in a list, it has the
+ // same meaning as if every explicit member of the common block
+ // appeared in the list
+ for (const Symbol &object :
+ symbol->get<CommonBlockDetails>().objects()) {
+ Symbol &mutableObject{const_cast<Symbol &>(object)};
+ if (auto *resolvedObject{ResolveOmp(mutableObject, ompFlag)}) {
+ AddToContextObjectWithDSA(*resolvedObject, ompFlag);
+ }
+ }
+ } else {
+ context_.Say(name.source, // 2.15.3
+ "COMMON block must be declared in the same scoping unit "
+ "in which the OpenMP directive or clause appears"_err_en_US);
+ }
+ },
+ },
+ ompObject.u);
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmp(
+ const parser::Name &name, Symbol::Flag ompFlag) {
+ if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+ return DeclarePrivateAccessEntity(name, ompFlag);
+ } else {
+ return DeclareOrMarkOtherAccessEntity(name, ompFlag);
+ }
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmp(Symbol &symbol, Symbol::Flag ompFlag) {
+ if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+ return DeclarePrivateAccessEntity(symbol, ompFlag);
+ } else {
+ return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
+ }
+}
+
+Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
+ const parser::Name &name, Symbol::Flag ompFlag) {
+ if (!name.symbol) {
+ return nullptr; // not resolved by Name Resolution step, do nothing
+ }
+ name.symbol = DeclarePrivateAccessEntity(*name.symbol, ompFlag);
+ return name.symbol;
+}
+
+Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
+ Symbol &object, Symbol::Flag ompFlag) {
+ if (object.owner() != currScope()) {
+ auto &symbol{MakeAssocSymbol(object.name(), object)};
+ symbol.set(ompFlag);
+ return &symbol;
+ } else {
+ object.set(ompFlag);
+ return &object;
+ }
+}
+
+Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
+ const parser::Name &name, Symbol::Flag ompFlag) {
+ Symbol *prev{currScope().FindSymbol(name.source)};
+ if (!name.symbol || !prev) {
+ return nullptr;
+ } else if (prev != name.symbol) {
+ name.symbol = prev;
+ }
+ return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
+}
+
+Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
+ Symbol &object, Symbol::Flag ompFlag) {
+ if (ompFlagsRequireMark.test(ompFlag)) {
+ object.set(ompFlag);
+ }
+ return &object;
+}
+
+static bool WithMultipleAppearancesException(
+ const Symbol &symbol, Symbol::Flag ompFlag) {
+ return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
+ symbol.test(Symbol::Flag::OmpLastPrivate)) ||
+ (ompFlag == Symbol::Flag::OmpLastPrivate &&
+ symbol.test(Symbol::Flag::OmpFirstPrivate));
+}
+
+void OmpAttributeVisitor::CheckMultipleAppearances(
+ const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
+ const auto *target{&symbol};
+ if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+ if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
+ target = &details->symbol();
+ }
+ }
+ if (HasDataSharingAttributeObject(*target) &&
+ !WithMultipleAppearancesException(symbol, ompFlag)) {
+ context_.Say(name.source,
+ "'%s' appears in more than one data-sharing clause "
+ "on the same OpenMP directive"_err_en_US,
+ name.ToString());
+ } else {
+ AddDataSharingAttributeObject(*target);
+ }
+}
+
// Perform checks and completions that need to happen after all of
// the specification parts but before any of the execution parts.
void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {