1 //===----------------------------------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "resolve-directives.h"
10 
11 #include "check-acc-structure.h"
12 #include "check-omp-structure.h"
13 #include "resolve-names-utils.h"
14 #include "flang/Common/idioms.h"
15 #include "flang/Evaluate/fold.h"
16 #include "flang/Evaluate/type.h"
17 #include "flang/Parser/parse-tree-visitor.h"
18 #include "flang/Parser/parse-tree.h"
19 #include "flang/Parser/tools.h"
20 #include "flang/Semantics/expression.h"
21 #include <list>
22 #include <map>
23 
24 namespace Fortran::semantics {
25 
26 template <typename T> class DirectiveAttributeVisitor {
27 public:
DirectiveAttributeVisitor(SemanticsContext & context)28   explicit DirectiveAttributeVisitor(SemanticsContext &context)
29       : context_{context} {}
30 
Pre(const A &)31   template <typename A> bool Pre(const A &) { return true; }
Post(const A &)32   template <typename A> void Post(const A &) {}
33 
34 protected:
35   struct DirContext {
DirContextFortran::semantics::DirectiveAttributeVisitor::DirContext36     DirContext(const parser::CharBlock &source, T d, Scope &s)
37         : directiveSource{source}, directive{d}, scope{s} {}
38     parser::CharBlock directiveSource;
39     T directive;
40     Scope &scope;
41     Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC
42     std::map<const Symbol *, Symbol::Flag> objectWithDSA;
43     bool withinConstruct{false};
44     std::int64_t associatedLoopLevel{0};
45   };
46 
GetContext()47   DirContext &GetContext() {
48     CHECK(!dirContext_.empty());
49     return dirContext_.back();
50   }
GetContextIf()51   std::optional<DirContext> GetContextIf() {
52     return dirContext_.empty()
53         ? std::nullopt
54         : std::make_optional<DirContext>(dirContext_.back());
55   }
PushContext(const parser::CharBlock & source,T dir)56   void PushContext(const parser::CharBlock &source, T dir) {
57     dirContext_.emplace_back(source, dir, context_.FindScope(source));
58   }
PopContext()59   void PopContext() { dirContext_.pop_back(); }
SetContextDirectiveSource(parser::CharBlock & dir)60   void SetContextDirectiveSource(parser::CharBlock &dir) {
61     GetContext().directiveSource = dir;
62   }
currScope()63   Scope &currScope() { return GetContext().scope; }
SetContextDefaultDSA(Symbol::Flag flag)64   void SetContextDefaultDSA(Symbol::Flag flag) {
65     GetContext().defaultDSA = flag;
66   }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag,DirContext & context)67   void AddToContextObjectWithDSA(
68       const Symbol &symbol, Symbol::Flag flag, DirContext &context) {
69     context.objectWithDSA.emplace(&symbol, flag);
70   }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag)71   void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
72     AddToContextObjectWithDSA(symbol, flag, GetContext());
73   }
IsObjectWithDSA(const Symbol & symbol)74   bool IsObjectWithDSA(const Symbol &symbol) {
75     auto it{GetContext().objectWithDSA.find(&symbol)};
76     return it != GetContext().objectWithDSA.end();
77   }
SetContextAssociatedLoopLevel(std::int64_t level)78   void SetContextAssociatedLoopLevel(std::int64_t level) {
79     GetContext().associatedLoopLevel = level;
80   }
MakeAssocSymbol(const SourceName & name,Symbol & prev,Scope & scope)81   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev, Scope &scope) {
82     const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
83     return *pair.first->second;
84   }
MakeAssocSymbol(const SourceName & name,Symbol & prev)85   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
86     return MakeAssocSymbol(name, prev, currScope());
87   }
GetDesignatorNameIfDataRef(const parser::Designator & designator)88   static const parser::Name *GetDesignatorNameIfDataRef(
89       const parser::Designator &designator) {
90     const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
91     return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
92   }
AddDataSharingAttributeObject(SymbolRef object)93   void AddDataSharingAttributeObject(SymbolRef object) {
94     dataSharingAttributeObjects_.insert(object);
95   }
ClearDataSharingAttributeObjects()96   void ClearDataSharingAttributeObjects() {
97     dataSharingAttributeObjects_.clear();
98   }
99   bool HasDataSharingAttributeObject(const Symbol &);
100   const parser::Name &GetLoopIndex(const parser::DoConstruct &);
101   const parser::DoConstruct *GetDoConstructIf(
102       const parser::ExecutionPartConstruct &);
103   Symbol *DeclarePrivateAccessEntity(
104       const parser::Name &, Symbol::Flag, Scope &);
105   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &);
106   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
107 
108   UnorderedSymbolSet dataSharingAttributeObjects_; // on one directive
109   SemanticsContext &context_;
110   std::vector<DirContext> dirContext_; // used as a stack
111 };
112 
113 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
114 public:
AccAttributeVisitor(SemanticsContext & context)115   explicit AccAttributeVisitor(SemanticsContext &context)
116       : DirectiveAttributeVisitor(context) {}
117 
Walk(const A & x)118   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)119   template <typename A> bool Pre(const A &) { return true; }
Post(const A &)120   template <typename A> void Post(const A &) {}
121 
122   bool Pre(const parser::OpenACCBlockConstruct &);
Post(const parser::OpenACCBlockConstruct &)123   void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
124   bool Pre(const parser::OpenACCCombinedConstruct &);
Post(const parser::OpenACCCombinedConstruct &)125   void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
126 
127   bool Pre(const parser::OpenACCDeclarativeConstruct &);
Post(const parser::OpenACCDeclarativeConstruct &)128   void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); }
129 
130   bool Pre(const parser::OpenACCRoutineConstruct &);
131   bool Pre(const parser::AccBindClause &);
132   void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);
133 
Post(const parser::AccBeginBlockDirective &)134   void Post(const parser::AccBeginBlockDirective &) {
135     GetContext().withinConstruct = true;
136   }
137 
138   bool Pre(const parser::OpenACCLoopConstruct &);
Post(const parser::OpenACCLoopConstruct &)139   void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
Post(const parser::AccLoopDirective &)140   void Post(const parser::AccLoopDirective &) {
141     GetContext().withinConstruct = true;
142   }
143 
144   bool Pre(const parser::OpenACCStandaloneConstruct &);
Post(const parser::OpenACCStandaloneConstruct &)145   void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
Post(const parser::AccStandaloneDirective &)146   void Post(const parser::AccStandaloneDirective &) {
147     GetContext().withinConstruct = true;
148   }
149 
150   bool Pre(const parser::OpenACCCacheConstruct &);
Post(const parser::OpenACCCacheConstruct &)151   void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
152 
153   void Post(const parser::AccDefaultClause &);
154 
155   bool Pre(const parser::AccClause::Attach &);
156   bool Pre(const parser::AccClause::Detach &);
157 
Pre(const parser::AccClause::Copy & x)158   bool Pre(const parser::AccClause::Copy &x) {
159     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
160     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
161     return false;
162   }
163 
Pre(const parser::AccClause::Create & x)164   bool Pre(const parser::AccClause::Create &x) {
165     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
166     ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);
167     return false;
168   }
169 
Pre(const parser::AccClause::Copyin & x)170   bool Pre(const parser::AccClause::Copyin &x) {
171     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
172     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);
173     return false;
174   }
175 
Pre(const parser::AccClause::Copyout & x)176   bool Pre(const parser::AccClause::Copyout &x) {
177     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
178     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);
179     return false;
180   }
181 
Pre(const parser::AccClause::Present & x)182   bool Pre(const parser::AccClause::Present &x) {
183     ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);
184     return false;
185   }
Pre(const parser::AccClause::Private & x)186   bool Pre(const parser::AccClause::Private &x) {
187     ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);
188     return false;
189   }
Pre(const parser::AccClause::Firstprivate & x)190   bool Pre(const parser::AccClause::Firstprivate &x) {
191     ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);
192     return false;
193   }
194 
195   void Post(const parser::Name &);
196 
197 private:
198   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
199 
200   static constexpr Symbol::Flags dataSharingAttributeFlags{
201       Symbol::Flag::AccShared, Symbol::Flag::AccPrivate,
202       Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate,
203       Symbol::Flag::AccReduction};
204 
205   static constexpr Symbol::Flags dataMappingAttributeFlags{
206       Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn,
207       Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete};
208 
209   static constexpr Symbol::Flags accFlagsRequireNewSymbol{
210       Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,
211       Symbol::Flag::AccReduction};
212 
213   static constexpr Symbol::Flags accFlagsRequireMark{};
214 
215   void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &);
216   void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
217   void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
218   Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
219   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
220   Symbol *ResolveName(const parser::Name &);
221   Symbol *ResolveAccCommonBlockName(const parser::Name *);
222   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
223   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
224   void CheckMultipleAppearances(
225       const parser::Name &, const Symbol &, Symbol::Flag);
226   void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
227   void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
228   void EnsureAllocatableOrPointer(
229       const llvm::acc::Clause clause, const parser::AccObjectList &objectList);
230 };
231 
232 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
233 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
234 public:
OmpAttributeVisitor(SemanticsContext & context)235   explicit OmpAttributeVisitor(SemanticsContext &context)
236       : DirectiveAttributeVisitor(context) {}
237 
Walk(const A & x)238   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)239   template <typename A> bool Pre(const A &) { return true; }
Post(const A &)240   template <typename A> void Post(const A &) {}
241 
Pre(const parser::Statement<A> & statement)242   template <typename A> bool Pre(const parser::Statement<A> &statement) {
243     currentStatementSource_ = statement.source;
244     // Keep track of the labels in all the labelled statements
245     if (statement.label) {
246       auto label{statement.label.value()};
247       // Get the context to check if the labelled statement is in an
248       // enclosing OpenMP construct
249       std::optional<DirContext> thisContext{GetContextIf()};
250       targetLabels_.emplace(
251           label, std::make_pair(currentStatementSource_, thisContext));
252       // Check if a statement that causes a jump to the 'label'
253       // has already been encountered
254       auto range{sourceLabels_.equal_range(label)};
255       for (auto it{range.first}; it != range.second; ++it) {
256         // Check if both the statement with 'label' and the statement that
257         // causes a jump to the 'label' are in the same scope
258         CheckLabelContext(it->second.first, currentStatementSource_,
259             it->second.second, thisContext);
260       }
261     }
262     return true;
263   }
264 
Pre(const parser::InternalSubprogram &)265   bool Pre(const parser::InternalSubprogram &) {
266     // Clear the labels being tracked in the previous scope
267     ClearLabels();
268     return true;
269   }
270 
Pre(const parser::ModuleSubprogram &)271   bool Pre(const parser::ModuleSubprogram &) {
272     // Clear the labels being tracked in the previous scope
273     ClearLabels();
274     return true;
275   }
276 
Pre(const parser::SpecificationPart & x)277   bool Pre(const parser::SpecificationPart &x) {
278     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
279     return true;
280   }
281 
Pre(const parser::StmtFunctionStmt & x)282   bool Pre(const parser::StmtFunctionStmt &x) {
283     const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
284     if (const auto *expr{GetExpr(context_, parsedExpr)}) {
285       for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
286         if (!IsStmtFunctionDummy(symbol)) {
287           stmtFunctionExprSymbols_.insert(symbol.GetUltimate());
288         }
289       }
290     }
291     return true;
292   }
293 
294   bool Pre(const parser::OpenMPBlockConstruct &);
295   void Post(const parser::OpenMPBlockConstruct &);
296 
Post(const parser::OmpBeginBlockDirective &)297   void Post(const parser::OmpBeginBlockDirective &) {
298     GetContext().withinConstruct = true;
299   }
300 
301   bool Pre(const parser::OpenMPSimpleStandaloneConstruct &);
Post(const parser::OpenMPSimpleStandaloneConstruct &)302   void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); }
303 
304   bool Pre(const parser::OpenMPLoopConstruct &);
Post(const parser::OpenMPLoopConstruct &)305   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
Post(const parser::OmpBeginLoopDirective &)306   void Post(const parser::OmpBeginLoopDirective &) {
307     GetContext().withinConstruct = true;
308   }
309   bool Pre(const parser::DoConstruct &);
310 
311   bool Pre(const parser::OpenMPSectionsConstruct &);
Post(const parser::OpenMPSectionsConstruct &)312   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
313 
314   bool Pre(const parser::OpenMPCriticalConstruct &critical);
Post(const parser::OpenMPCriticalConstruct &)315   void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); }
316 
Pre(const parser::OpenMPDeclareSimdConstruct & x)317   bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
318     PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd);
319     const auto &name{std::get<std::optional<parser::Name>>(x.t)};
320     if (name) {
321       ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd);
322     }
323     return true;
324   }
Post(const parser::OpenMPDeclareSimdConstruct &)325   void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }
326   bool Pre(const parser::OpenMPThreadprivate &);
Post(const parser::OpenMPThreadprivate &)327   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
328 
329   bool Pre(const parser::OpenMPDeclarativeAllocate &);
Post(const parser::OpenMPDeclarativeAllocate &)330   void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); }
331 
332   bool Pre(const parser::OpenMPExecutableAllocate &);
333   void Post(const parser::OpenMPExecutableAllocate &);
334 
335   // 2.15.3 Data-Sharing Attribute Clauses
336   void Post(const parser::OmpDefaultClause &);
Pre(const parser::OmpClause::Shared & x)337   bool Pre(const parser::OmpClause::Shared &x) {
338     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
339     return false;
340   }
Pre(const parser::OmpClause::Private & x)341   bool Pre(const parser::OmpClause::Private &x) {
342     ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
343     return false;
344   }
Pre(const parser::OmpAllocateClause & x)345   bool Pre(const parser::OmpAllocateClause &x) {
346     const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
347     ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate);
348     return false;
349   }
Pre(const parser::OmpClause::Firstprivate & x)350   bool Pre(const parser::OmpClause::Firstprivate &x) {
351     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
352     return false;
353   }
Pre(const parser::OmpClause::Lastprivate & x)354   bool Pre(const parser::OmpClause::Lastprivate &x) {
355     ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
356     return false;
357   }
Pre(const parser::OmpClause::Copyin & x)358   bool Pre(const parser::OmpClause::Copyin &x) {
359     ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);
360     return false;
361   }
Pre(const parser::OmpClause::Copyprivate & x)362   bool Pre(const parser::OmpClause::Copyprivate &x) {
363     ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyPrivate);
364     return false;
365   }
Pre(const parser::OmpLinearClause & x)366   bool Pre(const parser::OmpLinearClause &x) {
367     common::visit(common::visitors{
368                       [&](const parser::OmpLinearClause::WithoutModifier
369                               &linearWithoutModifier) {
370                         ResolveOmpNameList(linearWithoutModifier.names,
371                             Symbol::Flag::OmpLinear);
372                       },
373                       [&](const parser::OmpLinearClause::WithModifier
374                               &linearWithModifier) {
375                         ResolveOmpNameList(
376                             linearWithModifier.names, Symbol::Flag::OmpLinear);
377                       },
378                   },
379         x.u);
380     return false;
381   }
382 
Pre(const parser::OmpClause::Reduction & x)383   bool Pre(const parser::OmpClause::Reduction &x) {
384     const parser::OmpReductionOperator &opr{
385         std::get<parser::OmpReductionOperator>(x.v.t)};
386     if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {
387       if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
388         if (!name->symbol) {
389           const auto namePair{currScope().try_emplace(
390               name->source, Attrs{}, ProcEntityDetails{})};
391           auto &symbol{*namePair.first->second};
392           name->symbol = &symbol;
393           name->symbol->set(Symbol::Flag::OmpReduction);
394           AddToContextObjectWithDSA(*name->symbol, Symbol::Flag::OmpReduction);
395         }
396       }
397       if (const auto *procRef{
398               parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {
399         ResolveOmp(*procRef->v.thing.component.symbol,
400             Symbol::Flag::OmpReduction, currScope());
401       }
402     }
403     const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
404     ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction);
405     return false;
406   }
407 
Pre(const parser::OmpAlignedClause & x)408   bool Pre(const parser::OmpAlignedClause &x) {
409     const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)};
410     ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned);
411     return false;
412   }
413 
Pre(const parser::OmpClause::Nontemporal & x)414   bool Pre(const parser::OmpClause::Nontemporal &x) {
415     const auto &nontemporalNameList{x.v};
416     ResolveOmpNameList(nontemporalNameList, Symbol::Flag::OmpNontemporal);
417     return false;
418   }
419 
Pre(const parser::OmpDependClause & x)420   bool Pre(const parser::OmpDependClause &x) {
421     if (const auto *dependSink{
422             std::get_if<parser::OmpDependClause::Sink>(&x.u)}) {
423       const auto &dependSinkVec{dependSink->v};
424       for (const auto &dependSinkElement : dependSinkVec) {
425         const auto &name{std::get<parser::Name>(dependSinkElement.t)};
426         ResolveName(&name);
427       }
428     }
429     return false;
430   }
431 
432   void Post(const parser::Name &);
433 
434   // Keep track of labels in the statements that causes jumps to target labels
Post(const parser::GotoStmt & gotoStmt)435   void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); }
Post(const parser::ComputedGotoStmt & computedGotoStmt)436   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
437     for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
438       CheckSourceLabel(label);
439     }
440   }
Post(const parser::ArithmeticIfStmt & arithmeticIfStmt)441   void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
442     CheckSourceLabel(std::get<1>(arithmeticIfStmt.t));
443     CheckSourceLabel(std::get<2>(arithmeticIfStmt.t));
444     CheckSourceLabel(std::get<3>(arithmeticIfStmt.t));
445   }
Post(const parser::AssignedGotoStmt & assignedGotoStmt)446   void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
447     for (auto &label : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
448       CheckSourceLabel(label);
449     }
450   }
Post(const parser::AltReturnSpec & altReturnSpec)451   void Post(const parser::AltReturnSpec &altReturnSpec) {
452     CheckSourceLabel(altReturnSpec.v);
453   }
Post(const parser::ErrLabel & errLabel)454   void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); }
Post(const parser::EndLabel & endLabel)455   void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); }
Post(const parser::EorLabel & eorLabel)456   void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); }
457 
458   const parser::OmpClause *associatedClause{nullptr};
SetAssociatedClause(const parser::OmpClause & c)459   void SetAssociatedClause(const parser::OmpClause &c) {
460     associatedClause = &c;
461   }
GetAssociatedClause()462   const parser::OmpClause *GetAssociatedClause() { return associatedClause; }
463 
464 private:
465   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
466 
467   static constexpr Symbol::Flags dataSharingAttributeFlags{
468       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
469       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
470       Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
471 
472   static constexpr Symbol::Flags privateDataSharingAttributeFlags{
473       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
474       Symbol::Flag::OmpLastPrivate};
475 
476   static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
477       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
478       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
479       Symbol::Flag::OmpReduction, Symbol::Flag::OmpCriticalLock,
480       Symbol::Flag::OmpCopyIn};
481 
482   static constexpr Symbol::Flags ompFlagsRequireMark{
483       Symbol::Flag::OmpThreadprivate};
484 
485   static constexpr Symbol::Flags dataCopyingAttributeFlags{
486       Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate};
487 
488   std::vector<const parser::Name *> allocateNames_; // on one directive
489   UnorderedSymbolSet privateDataSharingAttributeObjects_; // on one directive
490   UnorderedSymbolSet stmtFunctionExprSymbols_;
491   std::multimap<const parser::Label,
492       std::pair<parser::CharBlock, std::optional<DirContext>>>
493       sourceLabels_;
494   std::map<const parser::Label,
495       std::pair<parser::CharBlock, std::optional<DirContext>>>
496       targetLabels_;
497   parser::CharBlock currentStatementSource_;
498 
AddAllocateName(const parser::Name * & object)499   void AddAllocateName(const parser::Name *&object) {
500     allocateNames_.push_back(object);
501   }
ClearAllocateNames()502   void ClearAllocateNames() { allocateNames_.clear(); }
503 
AddPrivateDataSharingAttributeObjects(SymbolRef object)504   void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
505     privateDataSharingAttributeObjects_.insert(object);
506   }
ClearPrivateDataSharingAttributeObjects()507   void ClearPrivateDataSharingAttributeObjects() {
508     privateDataSharingAttributeObjects_.clear();
509   }
510 
511   // Predetermined DSA rules
512   void PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
513       const parser::OpenMPLoopConstruct &);
514   void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
515 
516   bool IsNestedInDirective(llvm::omp::Directive directive);
517   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
518   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
519   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
520   Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
521   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
522   void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
523   void ResolveOmpName(const parser::Name &, Symbol::Flag);
524   Symbol *ResolveName(const parser::Name *);
525   Symbol *ResolveOmpObjectScope(const parser::Name *);
526   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
527   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
528   void CheckMultipleAppearances(
529       const parser::Name &, const Symbol &, Symbol::Flag);
530 
531   void CheckDataCopyingClause(
532       const parser::Name &, const Symbol &, Symbol::Flag);
533   void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);
534   void CheckObjectInNamelist(
535       const parser::Name &, const Symbol &, Symbol::Flag);
536   void CheckSourceLabel(const parser::Label &);
537   void CheckLabelContext(const parser::CharBlock, const parser::CharBlock,
538       std::optional<DirContext>, std::optional<DirContext>);
ClearLabels()539   void ClearLabels() {
540     sourceLabels_.clear();
541     targetLabels_.clear();
542   };
543 
544   bool HasSymbolInEnclosingScope(const Symbol &, Scope &);
545   std::int64_t ordCollapseLevel{0};
546 };
547 
548 template <typename T>
HasDataSharingAttributeObject(const Symbol & object)549 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
550     const Symbol &object) {
551   auto it{dataSharingAttributeObjects_.find(object)};
552   return it != dataSharingAttributeObjects_.end();
553 }
554 
555 template <typename T>
GetLoopIndex(const parser::DoConstruct & x)556 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex(
557     const parser::DoConstruct &x) {
558   using Bounds = parser::LoopControl::Bounds;
559   return std::get<Bounds>(x.GetLoopControl()->u).name.thing;
560 }
561 
562 template <typename T>
GetDoConstructIf(const parser::ExecutionPartConstruct & x)563 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(
564     const parser::ExecutionPartConstruct &x) {
565   return parser::Unwrap<parser::DoConstruct>(x);
566 }
567 
568 template <typename T>
DeclarePrivateAccessEntity(const parser::Name & name,Symbol::Flag flag,Scope & scope)569 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
570     const parser::Name &name, Symbol::Flag flag, Scope &scope) {
571   if (!name.symbol) {
572     return nullptr; // not resolved by Name Resolution step, do nothing
573   }
574   name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope);
575   return name.symbol;
576 }
577 
578 template <typename T>
DeclarePrivateAccessEntity(Symbol & object,Symbol::Flag flag,Scope & scope)579 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
580     Symbol &object, Symbol::Flag flag, Scope &scope) {
581   if (object.owner() != currScope()) {
582     auto &symbol{MakeAssocSymbol(object.name(), object, scope)};
583     symbol.set(flag);
584     if (flag == Symbol::Flag::OmpCopyIn) {
585       // The symbol in copyin clause must be threadprivate entity.
586       symbol.set(Symbol::Flag::OmpThreadprivate);
587     }
588     return &symbol;
589   } else {
590     object.set(flag);
591     return &object;
592   }
593 }
594 
Pre(const parser::OpenACCBlockConstruct & x)595 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
596   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
597   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
598   switch (blockDir.v) {
599   case llvm::acc::Directive::ACCD_data:
600   case llvm::acc::Directive::ACCD_host_data:
601   case llvm::acc::Directive::ACCD_kernels:
602   case llvm::acc::Directive::ACCD_parallel:
603   case llvm::acc::Directive::ACCD_serial:
604     PushContext(blockDir.source, blockDir.v);
605     break;
606   default:
607     break;
608   }
609   ClearDataSharingAttributeObjects();
610   return true;
611 }
612 
Pre(const parser::OpenACCDeclarativeConstruct & x)613 bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) {
614   if (const auto *declConstruct{
615           std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) {
616     const auto &declDir{
617         std::get<parser::AccDeclarativeDirective>(declConstruct->t)};
618     PushContext(declDir.source, llvm::acc::Directive::ACCD_declare);
619   } else if (const auto *routineConstruct{
620                  std::get_if<parser::OpenACCRoutineConstruct>(&x.u)}) {
621     const auto &verbatim{std::get<parser::Verbatim>(routineConstruct->t)};
622     PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine);
623   }
624   ClearDataSharingAttributeObjects();
625   return true;
626 }
627 
GetAccObjectList(const parser::AccClause & clause)628 static const parser::AccObjectList &GetAccObjectList(
629     const parser::AccClause &clause) {
630   if (const auto *copyClause =
631           std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {
632     return copyClause->v;
633   } else if (const auto *createClause =
634                  std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {
635     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
636         createClause->v;
637     const Fortran::parser::AccObjectList &accObjectList =
638         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
639     return accObjectList;
640   } else if (const auto *copyinClause =
641                  std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {
642     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
643         copyinClause->v;
644     const Fortran::parser::AccObjectList &accObjectList =
645         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
646     return accObjectList;
647   } else if (const auto *copyoutClause =
648                  std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) {
649     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
650         copyoutClause->v;
651     const Fortran::parser::AccObjectList &accObjectList =
652         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
653     return accObjectList;
654   } else if (const auto *presentClause =
655                  std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) {
656     return presentClause->v;
657   } else if (const auto *deviceptrClause =
658                  std::get_if<Fortran::parser::AccClause::Deviceptr>(
659                      &clause.u)) {
660     return deviceptrClause->v;
661   } else if (const auto *deviceResidentClause =
662                  std::get_if<Fortran::parser::AccClause::DeviceResident>(
663                      &clause.u)) {
664     return deviceResidentClause->v;
665   } else if (const auto *linkClause =
666                  std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {
667     return linkClause->v;
668   } else {
669     llvm_unreachable("Clause without object list!");
670   }
671 }
672 
Post(const parser::OpenACCStandaloneDeclarativeConstruct & x)673 void AccAttributeVisitor::Post(
674     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
675   const auto &clauseList = std::get<parser::AccClauseList>(x.t);
676   for (const auto &clause : clauseList.v) {
677     // Restriction - line 2414
678     DoNotAllowAssumedSizedArray(GetAccObjectList(clause));
679   }
680 }
681 
Pre(const parser::OpenACCLoopConstruct & x)682 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
683   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
684   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
685   const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
686   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
687     PushContext(loopDir.source, loopDir.v);
688   }
689   ClearDataSharingAttributeObjects();
690   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
691   PrivatizeAssociatedLoopIndex(x);
692   return true;
693 }
694 
Pre(const parser::OpenACCStandaloneConstruct & x)695 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
696   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
697   switch (standaloneDir.v) {
698   case llvm::acc::Directive::ACCD_enter_data:
699   case llvm::acc::Directive::ACCD_exit_data:
700   case llvm::acc::Directive::ACCD_init:
701   case llvm::acc::Directive::ACCD_set:
702   case llvm::acc::Directive::ACCD_shutdown:
703   case llvm::acc::Directive::ACCD_update:
704     PushContext(standaloneDir.source, standaloneDir.v);
705     break;
706   default:
707     break;
708   }
709   ClearDataSharingAttributeObjects();
710   return true;
711 }
712 
ResolveName(const parser::Name & name)713 Symbol *AccAttributeVisitor::ResolveName(const parser::Name &name) {
714   Symbol *prev{currScope().FindSymbol(name.source)};
715   if (prev != name.symbol) {
716     name.symbol = prev;
717   }
718   return prev;
719 }
720 
Pre(const parser::OpenACCRoutineConstruct & x)721 bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) {
722   const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
723   if (optName) {
724     if (!ResolveName(*optName)) {
725       context_.Say((*optName).source,
726           "No function or subroutine declared for '%s'"_err_en_US,
727           (*optName).source);
728     }
729   }
730   return true;
731 }
732 
Pre(const parser::AccBindClause & x)733 bool AccAttributeVisitor::Pre(const parser::AccBindClause &x) {
734   if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
735     if (!ResolveName(*name)) {
736       context_.Say(name->source,
737           "No function or subroutine declared for '%s'"_err_en_US,
738           name->source);
739     }
740   }
741   return true;
742 }
743 
Pre(const parser::OpenACCCombinedConstruct & x)744 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
745   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
746   const auto &combinedDir{
747       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
748   switch (combinedDir.v) {
749   case llvm::acc::Directive::ACCD_kernels_loop:
750   case llvm::acc::Directive::ACCD_parallel_loop:
751   case llvm::acc::Directive::ACCD_serial_loop:
752     PushContext(combinedDir.source, combinedDir.v);
753     break;
754   default:
755     break;
756   }
757   ClearDataSharingAttributeObjects();
758   return true;
759 }
760 
IsLastNameArray(const parser::Designator & designator)761 static bool IsLastNameArray(const parser::Designator &designator) {
762   const auto &name{GetLastName(designator)};
763   const evaluate::DataRef dataRef{*(name.symbol)};
764   return common::visit(
765       common::visitors{
766           [](const evaluate::SymbolRef &ref) { return ref->Rank() > 0; },
767           [](const evaluate::ArrayRef &aref) {
768             return aref.base().IsSymbol() ||
769                 aref.base().GetComponent().base().Rank() == 0;
770           },
771           [](const auto &) { return false; },
772       },
773       dataRef.u);
774 }
775 
AllowOnlyArrayAndSubArray(const parser::AccObjectList & objectList)776 void AccAttributeVisitor::AllowOnlyArrayAndSubArray(
777     const parser::AccObjectList &objectList) {
778   for (const auto &accObject : objectList.v) {
779     common::visit(
780         common::visitors{
781             [&](const parser::Designator &designator) {
782               if (!IsLastNameArray(designator)) {
783                 context_.Say(designator.source,
784                     "Only array element or subarray are allowed in %s directive"_err_en_US,
785                     parser::ToUpperCaseLetters(
786                         llvm::acc::getOpenACCDirectiveName(
787                             GetContext().directive)
788                             .str()));
789               }
790             },
791             [&](const auto &name) {
792               context_.Say(name.source,
793                   "Only array element or subarray are allowed in %s directive"_err_en_US,
794                   parser::ToUpperCaseLetters(
795                       llvm::acc::getOpenACCDirectiveName(GetContext().directive)
796                           .str()));
797             },
798         },
799         accObject.u);
800   }
801 }
802 
DoNotAllowAssumedSizedArray(const parser::AccObjectList & objectList)803 void AccAttributeVisitor::DoNotAllowAssumedSizedArray(
804     const parser::AccObjectList &objectList) {
805   for (const auto &accObject : objectList.v) {
806     common::visit(
807         common::visitors{
808             [&](const parser::Designator &designator) {
809               const auto &name{GetLastName(designator)};
810               if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) {
811                 context_.Say(designator.source,
812                     "Assumed-size dummy arrays may not appear on the %s "
813                     "directive"_err_en_US,
814                     parser::ToUpperCaseLetters(
815                         llvm::acc::getOpenACCDirectiveName(
816                             GetContext().directive)
817                             .str()));
818               }
819             },
820             [&](const auto &name) {
821 
822             },
823         },
824         accObject.u);
825   }
826 }
827 
Pre(const parser::OpenACCCacheConstruct & x)828 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
829   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
830   PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
831   ClearDataSharingAttributeObjects();
832 
833   const auto &objectListWithModifier =
834       std::get<parser::AccObjectListWithModifier>(x.t);
835   const auto &objectList =
836       std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);
837 
838   // 2.10 Cache directive restriction: A var in a cache directive must be a
839   // single array element or a simple subarray.
840   AllowOnlyArrayAndSubArray(objectList);
841 
842   return true;
843 }
844 
GetAssociatedLoopLevelFromClauses(const parser::AccClauseList & x)845 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
846     const parser::AccClauseList &x) {
847   std::int64_t collapseLevel{0};
848   for (const auto &clause : x.v) {
849     if (const auto *collapseClause{
850             std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
851       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
852         collapseLevel = *v;
853       }
854     }
855   }
856 
857   if (collapseLevel) {
858     return collapseLevel;
859   }
860   return 1; // default is outermost loop
861 }
862 
PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct & x)863 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex(
864     const parser::OpenACCLoopConstruct &x) {
865   std::int64_t level{GetContext().associatedLoopLevel};
866   if (level <= 0) { // collpase value was negative or 0
867     return;
868   }
869   Symbol::Flag ivDSA{Symbol::Flag::AccPrivate};
870 
871   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
872   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
873     // go through all the nested do-loops and resolve index variables
874     const parser::Name &iv{GetLoopIndex(*loop)};
875     if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) {
876       symbol->set(Symbol::Flag::AccPreDetermined);
877       iv.symbol = symbol; // adjust the symbol within region
878       AddToContextObjectWithDSA(*symbol, ivDSA);
879     }
880 
881     const auto &block{std::get<parser::Block>(loop->t)};
882     const auto it{block.begin()};
883     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
884   }
885   CHECK(level == 0);
886 }
887 
EnsureAllocatableOrPointer(const llvm::acc::Clause clause,const parser::AccObjectList & objectList)888 void AccAttributeVisitor::EnsureAllocatableOrPointer(
889     const llvm::acc::Clause clause, const parser::AccObjectList &objectList) {
890   for (const auto &accObject : objectList.v) {
891     common::visit(
892         common::visitors{
893             [&](const parser::Designator &designator) {
894               const auto &lastName{GetLastName(designator)};
895               if (!IsAllocatableOrPointer(*lastName.symbol)) {
896                 context_.Say(designator.source,
897                     "Argument `%s` on the %s clause must be a variable or "
898                     "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
899                     lastName.symbol->name(),
900                     parser::ToUpperCaseLetters(
901                         llvm::acc::getOpenACCClauseName(clause).str()));
902               }
903             },
904             [&](const auto &name) {
905               context_.Say(name.source,
906                   "Argument on the %s clause must be a variable or "
907                   "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
908                   parser::ToUpperCaseLetters(
909                       llvm::acc::getOpenACCClauseName(clause).str()));
910             },
911         },
912         accObject.u);
913   }
914 }
915 
Pre(const parser::AccClause::Attach & x)916 bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) {
917   // Restriction - line 1708-1709
918   EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v);
919   return true;
920 }
921 
Pre(const parser::AccClause::Detach & x)922 bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) {
923   // Restriction - line 1715-1717
924   EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v);
925   return true;
926 }
927 
Post(const parser::AccDefaultClause & x)928 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
929   if (!dirContext_.empty()) {
930     switch (x.v) {
931     case llvm::acc::DefaultValue::ACC_Default_present:
932       SetContextDefaultDSA(Symbol::Flag::AccPresent);
933       break;
934     case llvm::acc::DefaultValue::ACC_Default_none:
935       SetContextDefaultDSA(Symbol::Flag::AccNone);
936       break;
937     }
938   }
939 }
940 
941 // For OpenACC constructs, check all the data-refs within the constructs
942 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)943 void AccAttributeVisitor::Post(const parser::Name &name) {
944   auto *symbol{name.symbol};
945   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
946     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
947         !IsObjectWithDSA(*symbol)) {
948       if (Symbol * found{currScope().FindSymbol(name.source)}) {
949         if (symbol != found) {
950           name.symbol = found; // adjust the symbol within region
951         } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
952           // 2.5.14.
953           context_.Say(name.source,
954               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
955               "a data-mapping clause"_err_en_US,
956               symbol->name());
957         }
958       }
959     }
960   } // within OpenACC construct
961 }
962 
ResolveAccCommonBlockName(const parser::Name * name)963 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
964     const parser::Name *name) {
965   if (!name) {
966     return nullptr;
967   } else if (auto *prev{
968                  GetContext().scope.parent().FindCommonBlock(name->source)}) {
969     name->symbol = prev;
970     return prev;
971   } else {
972     return nullptr;
973   }
974 }
975 
ResolveAccObjectList(const parser::AccObjectList & accObjectList,Symbol::Flag accFlag)976 void AccAttributeVisitor::ResolveAccObjectList(
977     const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
978   for (const auto &accObject : accObjectList.v) {
979     ResolveAccObject(accObject, accFlag);
980   }
981 }
982 
ResolveAccObject(const parser::AccObject & accObject,Symbol::Flag accFlag)983 void AccAttributeVisitor::ResolveAccObject(
984     const parser::AccObject &accObject, Symbol::Flag accFlag) {
985   common::visit(
986       common::visitors{
987           [&](const parser::Designator &designator) {
988             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
989               if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {
990                 AddToContextObjectWithDSA(*symbol, accFlag);
991                 if (dataSharingAttributeFlags.test(accFlag)) {
992                   CheckMultipleAppearances(*name, *symbol, accFlag);
993                 }
994               }
995             } else {
996               // Array sections to be changed to substrings as needed
997               if (AnalyzeExpr(context_, designator)) {
998                 if (std::holds_alternative<parser::Substring>(designator.u)) {
999                   context_.Say(designator.source,
1000                       "Substrings are not allowed on OpenACC "
1001                       "directives or clauses"_err_en_US);
1002                 }
1003               }
1004               // other checks, more TBD
1005             }
1006           },
1007           [&](const parser::Name &name) { // common block
1008             if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
1009               CheckMultipleAppearances(
1010                   name, *symbol, Symbol::Flag::AccCommonBlock);
1011               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
1012                 if (auto *resolvedObject{
1013                         ResolveAcc(*object, accFlag, currScope())}) {
1014                   AddToContextObjectWithDSA(*resolvedObject, accFlag);
1015                 }
1016               }
1017             } else {
1018               context_.Say(name.source,
1019                   "COMMON block must be declared in the same scoping unit "
1020                   "in which the OpenACC directive or clause appears"_err_en_US);
1021             }
1022           },
1023       },
1024       accObject.u);
1025 }
1026 
ResolveAcc(const parser::Name & name,Symbol::Flag accFlag,Scope & scope)1027 Symbol *AccAttributeVisitor::ResolveAcc(
1028     const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
1029   if (accFlagsRequireNewSymbol.test(accFlag)) {
1030     return DeclarePrivateAccessEntity(name, accFlag, scope);
1031   } else {
1032     return DeclareOrMarkOtherAccessEntity(name, accFlag);
1033   }
1034 }
1035 
ResolveAcc(Symbol & symbol,Symbol::Flag accFlag,Scope & scope)1036 Symbol *AccAttributeVisitor::ResolveAcc(
1037     Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
1038   if (accFlagsRequireNewSymbol.test(accFlag)) {
1039     return DeclarePrivateAccessEntity(symbol, accFlag, scope);
1040   } else {
1041     return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
1042   }
1043 }
1044 
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag accFlag)1045 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1046     const parser::Name &name, Symbol::Flag accFlag) {
1047   Symbol *prev{currScope().FindSymbol(name.source)};
1048   if (!name.symbol || !prev) {
1049     return nullptr;
1050   } else if (prev != name.symbol) {
1051     name.symbol = prev;
1052   }
1053   return DeclareOrMarkOtherAccessEntity(*prev, accFlag);
1054 }
1055 
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag accFlag)1056 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1057     Symbol &object, Symbol::Flag accFlag) {
1058   if (accFlagsRequireMark.test(accFlag)) {
1059     object.set(accFlag);
1060   }
1061   return &object;
1062 }
1063 
WithMultipleAppearancesAccException(const Symbol & symbol,Symbol::Flag flag)1064 static bool WithMultipleAppearancesAccException(
1065     const Symbol &symbol, Symbol::Flag flag) {
1066   return false; // Place holder
1067 }
1068 
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag accFlag)1069 void AccAttributeVisitor::CheckMultipleAppearances(
1070     const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {
1071   const auto *target{&symbol};
1072   if (accFlagsRequireNewSymbol.test(accFlag)) {
1073     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
1074       target = &details->symbol();
1075     }
1076   }
1077   if (HasDataSharingAttributeObject(*target) &&
1078       !WithMultipleAppearancesAccException(symbol, accFlag)) {
1079     context_.Say(name.source,
1080         "'%s' appears in more than one data-sharing clause "
1081         "on the same OpenACC directive"_err_en_US,
1082         name.ToString());
1083   } else {
1084     AddDataSharingAttributeObject(*target);
1085   }
1086 }
1087 
Pre(const parser::OpenMPBlockConstruct & x)1088 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1089   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1090   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1091   switch (beginDir.v) {
1092   case llvm::omp::Directive::OMPD_master:
1093   case llvm::omp::Directive::OMPD_ordered:
1094   case llvm::omp::Directive::OMPD_parallel:
1095   case llvm::omp::Directive::OMPD_single:
1096   case llvm::omp::Directive::OMPD_target:
1097   case llvm::omp::Directive::OMPD_target_data:
1098   case llvm::omp::Directive::OMPD_task:
1099   case llvm::omp::Directive::OMPD_taskgroup:
1100   case llvm::omp::Directive::OMPD_teams:
1101   case llvm::omp::Directive::OMPD_workshare:
1102   case llvm::omp::Directive::OMPD_parallel_workshare:
1103   case llvm::omp::Directive::OMPD_target_teams:
1104   case llvm::omp::Directive::OMPD_target_parallel:
1105     PushContext(beginDir.source, beginDir.v);
1106     break;
1107   default:
1108     // TODO others
1109     break;
1110   }
1111   ClearDataSharingAttributeObjects();
1112   ClearPrivateDataSharingAttributeObjects();
1113   ClearAllocateNames();
1114   return true;
1115 }
1116 
Post(const parser::OpenMPBlockConstruct & x)1117 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1118   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1119   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1120   switch (beginDir.v) {
1121   case llvm::omp::Directive::OMPD_parallel:
1122   case llvm::omp::Directive::OMPD_single:
1123   case llvm::omp::Directive::OMPD_target:
1124   case llvm::omp::Directive::OMPD_task:
1125   case llvm::omp::Directive::OMPD_teams:
1126   case llvm::omp::Directive::OMPD_parallel_workshare:
1127   case llvm::omp::Directive::OMPD_target_teams:
1128   case llvm::omp::Directive::OMPD_target_parallel: {
1129     bool hasPrivate;
1130     for (const auto *allocName : allocateNames_) {
1131       hasPrivate = false;
1132       for (auto privateObj : privateDataSharingAttributeObjects_) {
1133         const Symbol &symbolPrivate{*privateObj};
1134         if (allocName->source == symbolPrivate.name()) {
1135           hasPrivate = true;
1136           break;
1137         }
1138       }
1139       if (!hasPrivate) {
1140         context_.Say(allocName->source,
1141             "The ALLOCATE clause requires that '%s' must be listed in a "
1142             "private "
1143             "data-sharing attribute clause on the same directive"_err_en_US,
1144             allocName->ToString());
1145       }
1146     }
1147     break;
1148   }
1149   default:
1150     break;
1151   }
1152   PopContext();
1153 }
1154 
Pre(const parser::OpenMPSimpleStandaloneConstruct & x)1155 bool OmpAttributeVisitor::Pre(
1156     const parser::OpenMPSimpleStandaloneConstruct &x) {
1157   const auto &standaloneDir{
1158       std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
1159   switch (standaloneDir.v) {
1160   case llvm::omp::Directive::OMPD_barrier:
1161   case llvm::omp::Directive::OMPD_ordered:
1162   case llvm::omp::Directive::OMPD_target_enter_data:
1163   case llvm::omp::Directive::OMPD_target_exit_data:
1164   case llvm::omp::Directive::OMPD_target_update:
1165   case llvm::omp::Directive::OMPD_taskwait:
1166   case llvm::omp::Directive::OMPD_taskyield:
1167     PushContext(standaloneDir.source, standaloneDir.v);
1168     break;
1169   default:
1170     break;
1171   }
1172   ClearDataSharingAttributeObjects();
1173   return true;
1174 }
1175 
Pre(const parser::OpenMPLoopConstruct & x)1176 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
1177   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1178   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
1179   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1180   switch (beginDir.v) {
1181   case llvm::omp::Directive::OMPD_distribute:
1182   case llvm::omp::Directive::OMPD_distribute_parallel_do:
1183   case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
1184   case llvm::omp::Directive::OMPD_distribute_simd:
1185   case llvm::omp::Directive::OMPD_do:
1186   case llvm::omp::Directive::OMPD_do_simd:
1187   case llvm::omp::Directive::OMPD_parallel_do:
1188   case llvm::omp::Directive::OMPD_parallel_do_simd:
1189   case llvm::omp::Directive::OMPD_simd:
1190   case llvm::omp::Directive::OMPD_target_parallel_do:
1191   case llvm::omp::Directive::OMPD_target_parallel_do_simd:
1192   case llvm::omp::Directive::OMPD_target_teams_distribute:
1193   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1194   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1195   case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1196   case llvm::omp::Directive::OMPD_target_simd:
1197   case llvm::omp::Directive::OMPD_taskloop:
1198   case llvm::omp::Directive::OMPD_taskloop_simd:
1199   case llvm::omp::Directive::OMPD_teams_distribute:
1200   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
1201   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
1202   case llvm::omp::Directive::OMPD_teams_distribute_simd:
1203     PushContext(beginDir.source, beginDir.v);
1204     break;
1205   default:
1206     break;
1207   }
1208   ClearDataSharingAttributeObjects();
1209   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
1210 
1211   if (beginDir.v == llvm::omp::Directive::OMPD_do) {
1212     if (const auto &doConstruct{
1213             std::get<std::optional<parser::DoConstruct>>(x.t)}) {
1214       if (doConstruct.value().IsDoWhile()) {
1215         return true;
1216       }
1217     }
1218   }
1219   PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
1220   ordCollapseLevel = GetAssociatedLoopLevelFromClauses(clauseList) + 1;
1221   return true;
1222 }
1223 
ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name & iv)1224 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
1225     const parser::Name &iv) {
1226   auto targetIt{dirContext_.rbegin()};
1227   for (;; ++targetIt) {
1228     if (targetIt == dirContext_.rend()) {
1229       return;
1230     }
1231     if (llvm::omp::parallelSet.test(targetIt->directive) ||
1232         llvm::omp::taskGeneratingSet.test(targetIt->directive)) {
1233       break;
1234     }
1235   }
1236   if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {
1237     targetIt++;
1238     symbol->set(Symbol::Flag::OmpPreDetermined);
1239     iv.symbol = symbol; // adjust the symbol within region
1240     for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {
1241       AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);
1242     }
1243   }
1244 }
1245 
1246 // [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined
1247 //   - A loop iteration variable for a sequential loop in a parallel
1248 //     or task generating construct is private in the innermost such
1249 //     construct that encloses the loop
1250 // Loop iteration variables are not well defined for DO WHILE loop.
1251 // Use of DO CONCURRENT inside OpenMP construct is unspecified behavior
1252 // till OpenMP-5.0 standard.
1253 // In above both cases we skip the privatization of iteration variables.
Pre(const parser::DoConstruct & x)1254 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
1255   // TODO:[OpenMP 5.1] DO CONCURRENT indices are private
1256   if (x.IsDoNormal()) {
1257     if (!dirContext_.empty() && GetContext().withinConstruct) {
1258       if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
1259         if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
1260           ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
1261         } else {
1262           // TODO: conflict checks with explicitly determined DSA
1263         }
1264         ordCollapseLevel--;
1265         if (ordCollapseLevel) {
1266           if (const auto *details{iv.symbol->detailsIf<HostAssocDetails>()}) {
1267             const Symbol *tpSymbol = &details->symbol();
1268             if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) {
1269               context_.Say(iv.source,
1270                   "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US,
1271                   iv.ToString());
1272             }
1273           }
1274         }
1275       }
1276     }
1277   }
1278   return true;
1279 }
1280 
GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList & x)1281 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
1282     const parser::OmpClauseList &x) {
1283   std::int64_t orderedLevel{0};
1284   std::int64_t collapseLevel{0};
1285 
1286   const parser::OmpClause *ordClause{nullptr};
1287   const parser::OmpClause *collClause{nullptr};
1288 
1289   for (const auto &clause : x.v) {
1290     if (const auto *orderedClause{
1291             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
1292       if (const auto v{EvaluateInt64(context_, orderedClause->v)}) {
1293         orderedLevel = *v;
1294       }
1295       ordClause = &clause;
1296     }
1297     if (const auto *collapseClause{
1298             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
1299       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
1300         collapseLevel = *v;
1301       }
1302       collClause = &clause;
1303     }
1304   }
1305 
1306   if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
1307     SetAssociatedClause(*ordClause);
1308     return orderedLevel;
1309   } else if (!orderedLevel && collapseLevel) {
1310     SetAssociatedClause(*collClause);
1311     return collapseLevel;
1312   } // orderedLevel < collapseLevel is an error handled in structural checks
1313   return 1; // default is outermost loop
1314 }
1315 
1316 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
1317 //   - The loop iteration variable(s) in the associated do-loop(s) of a do,
1318 //     parallel do, taskloop, or distribute construct is (are) private.
1319 //   - The loop iteration variable in the associated do-loop of a simd construct
1320 //     with just one associated do-loop is linear with a linear-step that is the
1321 //     increment of the associated do-loop.
1322 //   - The loop iteration variables in the associated do-loops of a simd
1323 //     construct with multiple associated do-loops are lastprivate.
PrivatizeAssociatedLoopIndexAndCheckLoopLevel(const parser::OpenMPLoopConstruct & x)1324 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
1325     const parser::OpenMPLoopConstruct &x) {
1326   std::int64_t level{GetContext().associatedLoopLevel};
1327   if (level <= 0) {
1328     return;
1329   }
1330   Symbol::Flag ivDSA;
1331   if (!llvm::omp::simdSet.test(GetContext().directive)) {
1332     ivDSA = Symbol::Flag::OmpPrivate;
1333   } else if (level == 1) {
1334     ivDSA = Symbol::Flag::OmpLinear;
1335   } else {
1336     ivDSA = Symbol::Flag::OmpLastPrivate;
1337   }
1338 
1339   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
1340   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
1341     // go through all the nested do-loops and resolve index variables
1342     const parser::Name &iv{GetLoopIndex(*loop)};
1343     if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) {
1344       symbol->set(Symbol::Flag::OmpPreDetermined);
1345       iv.symbol = symbol; // adjust the symbol within region
1346       AddToContextObjectWithDSA(*symbol, ivDSA);
1347     }
1348 
1349     const auto &block{std::get<parser::Block>(loop->t)};
1350     const auto it{block.begin()};
1351     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
1352   }
1353   CheckAssocLoopLevel(level, GetAssociatedClause());
1354 }
CheckAssocLoopLevel(std::int64_t level,const parser::OmpClause * clause)1355 void OmpAttributeVisitor::CheckAssocLoopLevel(
1356     std::int64_t level, const parser::OmpClause *clause) {
1357   if (clause && level != 0) {
1358     context_.Say(clause->source,
1359         "The value of the parameter in the COLLAPSE or ORDERED clause must"
1360         " not be larger than the number of nested loops"
1361         " following the construct."_err_en_US);
1362   }
1363 }
1364 
Pre(const parser::OpenMPSectionsConstruct & x)1365 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
1366   const auto &beginSectionsDir{
1367       std::get<parser::OmpBeginSectionsDirective>(x.t)};
1368   const auto &beginDir{
1369       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1370   switch (beginDir.v) {
1371   case llvm::omp::Directive::OMPD_parallel_sections:
1372   case llvm::omp::Directive::OMPD_sections:
1373     PushContext(beginDir.source, beginDir.v);
1374     break;
1375   default:
1376     break;
1377   }
1378   ClearDataSharingAttributeObjects();
1379   return true;
1380 }
1381 
Pre(const parser::OpenMPCriticalConstruct & x)1382 bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) {
1383   const auto &beginCriticalDir{std::get<parser::OmpCriticalDirective>(x.t)};
1384   const auto &endCriticalDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
1385   PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical);
1386   if (const auto &criticalName{
1387           std::get<std::optional<parser::Name>>(beginCriticalDir.t)}) {
1388     ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock);
1389   }
1390   if (const auto &endCriticalName{
1391           std::get<std::optional<parser::Name>>(endCriticalDir.t)}) {
1392     ResolveOmpName(*endCriticalName, Symbol::Flag::OmpCriticalLock);
1393   }
1394   return true;
1395 }
1396 
Pre(const parser::OpenMPThreadprivate & x)1397 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
1398   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
1399   const auto &list{std::get<parser::OmpObjectList>(x.t)};
1400   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
1401   return true;
1402 }
1403 
Pre(const parser::OpenMPDeclarativeAllocate & x)1404 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
1405   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
1406   const auto &list{std::get<parser::OmpObjectList>(x.t)};
1407   ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective);
1408   return false;
1409 }
1410 
Pre(const parser::OpenMPExecutableAllocate & x)1411 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
1412   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
1413   const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1414   if (list) {
1415     ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
1416   }
1417   return true;
1418 }
1419 
Post(const parser::OmpDefaultClause & x)1420 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
1421   if (!dirContext_.empty()) {
1422     switch (x.v) {
1423     case parser::OmpDefaultClause::Type::Private:
1424       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
1425       break;
1426     case parser::OmpDefaultClause::Type::Firstprivate:
1427       SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
1428       break;
1429     case parser::OmpDefaultClause::Type::Shared:
1430       SetContextDefaultDSA(Symbol::Flag::OmpShared);
1431       break;
1432     case parser::OmpDefaultClause::Type::None:
1433       SetContextDefaultDSA(Symbol::Flag::OmpNone);
1434       break;
1435     }
1436   }
1437 }
1438 
IsNestedInDirective(llvm::omp::Directive directive)1439 bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) {
1440   if (dirContext_.size() >= 1) {
1441     for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
1442       if (dirContext_[i - 1].directive == directive) {
1443         return true;
1444       }
1445     }
1446   }
1447   return false;
1448 }
1449 
Post(const parser::OpenMPExecutableAllocate & x)1450 void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
1451   bool hasAllocator = false;
1452   // TODO: Investigate whether searching the clause list can be done with
1453   // parser::Unwrap instead of the following loop
1454   const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1455   for (const auto &clause : clauseList.v) {
1456     if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) {
1457       hasAllocator = true;
1458     }
1459   }
1460 
1461   if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) {
1462     // TODO: expand this check to exclude the case when a requires
1463     //       directive with the dynamic_allocators clause is present
1464     //       in the same compilation unit (OMP5.0 2.11.3).
1465     context_.Say(x.source,
1466         "ALLOCATE directives that appear in a TARGET region "
1467         "must specify an allocator clause"_err_en_US);
1468   }
1469   PopContext();
1470 }
1471 
1472 // For OpenMP constructs, check all the data-refs within the constructs
1473 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)1474 void OmpAttributeVisitor::Post(const parser::Name &name) {
1475   auto *symbol{name.symbol};
1476   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
1477     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
1478         !IsObjectWithDSA(*symbol) && !IsNamedConstant(*symbol)) {
1479       // TODO: create a separate function to go through the rules for
1480       //       predetermined, explicitly determined, and implicitly
1481       //       determined data-sharing attributes (2.15.1.1).
1482       if (Symbol * found{currScope().FindSymbol(name.source)}) {
1483         if (symbol != found) {
1484           name.symbol = found; // adjust the symbol within region
1485         } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
1486           context_.Say(name.source,
1487               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
1488               "a data-sharing attribute clause"_err_en_US,
1489               symbol->name());
1490         }
1491       }
1492     }
1493   } // within OpenMP construct
1494 }
1495 
ResolveName(const parser::Name * name)1496 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) {
1497   if (auto *resolvedSymbol{
1498           name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
1499     name->symbol = resolvedSymbol;
1500     return resolvedSymbol;
1501   } else {
1502     return nullptr;
1503   }
1504 }
1505 
ResolveOmpName(const parser::Name & name,Symbol::Flag ompFlag)1506 void OmpAttributeVisitor::ResolveOmpName(
1507     const parser::Name &name, Symbol::Flag ompFlag) {
1508   if (ResolveName(&name)) {
1509     if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) {
1510       if (dataSharingAttributeFlags.test(ompFlag)) {
1511         AddToContextObjectWithDSA(*resolvedSymbol, ompFlag);
1512       }
1513     }
1514   } else if (ompFlag == Symbol::Flag::OmpCriticalLock) {
1515     const auto pair{
1516         GetContext().scope.try_emplace(name.source, Attrs{}, UnknownDetails{})};
1517     CHECK(pair.second);
1518     name.symbol = &pair.first->second.get();
1519   }
1520 }
1521 
ResolveOmpNameList(const std::list<parser::Name> & nameList,Symbol::Flag ompFlag)1522 void OmpAttributeVisitor::ResolveOmpNameList(
1523     const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) {
1524   for (const auto &name : nameList) {
1525     ResolveOmpName(name, ompFlag);
1526   }
1527 }
1528 
ResolveOmpCommonBlockName(const parser::Name * name)1529 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
1530     const parser::Name *name) {
1531   if (auto *prev{name
1532               ? GetContext().scope.parent().FindCommonBlock(name->source)
1533               : nullptr}) {
1534     name->symbol = prev;
1535     return prev;
1536   }
1537   // Check if the Common Block is declared in the current scope
1538   if (auto *commonBlockSymbol{
1539           name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
1540     name->symbol = commonBlockSymbol;
1541     return commonBlockSymbol;
1542   }
1543   return nullptr;
1544 }
1545 
1546 // Use this function over ResolveOmpName when an omp object's scope needs
1547 // resolving, it's symbol flag isn't important and a simple check for resolution
1548 // failure is desired. Using ResolveOmpName means needing to work with the
1549 // context to check for failure, whereas here a pointer comparison is all that's
1550 // needed.
ResolveOmpObjectScope(const parser::Name * name)1551 Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) {
1552 
1553   // TODO: Investigate whether the following block can be replaced by, or
1554   // included in, the ResolveOmpName function
1555   if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source)
1556                       : nullptr}) {
1557     name->symbol = prev;
1558     return nullptr;
1559   }
1560 
1561   // TODO: Investigate whether the following block can be replaced by, or
1562   // included in, the ResolveOmpName function
1563   if (auto *ompSymbol{
1564           name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
1565     name->symbol = ompSymbol;
1566     return ompSymbol;
1567   }
1568   return nullptr;
1569 }
1570 
ResolveOmpObjectList(const parser::OmpObjectList & ompObjectList,Symbol::Flag ompFlag)1571 void OmpAttributeVisitor::ResolveOmpObjectList(
1572     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
1573   for (const auto &ompObject : ompObjectList.v) {
1574     ResolveOmpObject(ompObject, ompFlag);
1575   }
1576 }
1577 
ResolveOmpObject(const parser::OmpObject & ompObject,Symbol::Flag ompFlag)1578 void OmpAttributeVisitor::ResolveOmpObject(
1579     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
1580   common::visit(
1581       common::visitors{
1582           [&](const parser::Designator &designator) {
1583             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
1584               if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
1585                 if (dataCopyingAttributeFlags.test(ompFlag)) {
1586                   CheckDataCopyingClause(*name, *symbol, ompFlag);
1587                 } else {
1588                   AddToContextObjectWithDSA(*symbol, ompFlag);
1589                   if (dataSharingAttributeFlags.test(ompFlag)) {
1590                     CheckMultipleAppearances(*name, *symbol, ompFlag);
1591                   }
1592                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
1593                     CheckObjectInNamelist(*name, *symbol, ompFlag);
1594                   }
1595 
1596                   if (ompFlag == Symbol::Flag::OmpAllocate) {
1597                     AddAllocateName(name);
1598                   }
1599                 }
1600                 if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
1601                     IsAllocatable(*symbol)) {
1602                   context_.Say(designator.source,
1603                       "List items specified in the ALLOCATE directive must not "
1604                       "have the ALLOCATABLE attribute unless the directive is "
1605                       "associated with an ALLOCATE statement"_err_en_US);
1606                 }
1607                 if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
1608                         ompFlag ==
1609                             Symbol::Flag::OmpExecutableAllocateDirective) &&
1610                     ResolveOmpObjectScope(name) == nullptr) {
1611                   context_.Say(designator.source, // 2.15.3
1612                       "List items must be declared in the same scoping unit "
1613                       "in which the ALLOCATE directive appears"_err_en_US);
1614                 }
1615               }
1616             } else {
1617               // Array sections to be changed to substrings as needed
1618               if (AnalyzeExpr(context_, designator)) {
1619                 if (std::holds_alternative<parser::Substring>(designator.u)) {
1620                   context_.Say(designator.source,
1621                       "Substrings are not allowed on OpenMP "
1622                       "directives or clauses"_err_en_US);
1623                 }
1624               }
1625               // other checks, more TBD
1626             }
1627           },
1628           [&](const parser::Name &name) { // common block
1629             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
1630               if (!dataCopyingAttributeFlags.test(ompFlag)) {
1631                 CheckMultipleAppearances(
1632                     name, *symbol, Symbol::Flag::OmpCommonBlock);
1633               }
1634               // 2.15.3 When a named common block appears in a list, it has the
1635               // same meaning as if every explicit member of the common block
1636               // appeared in the list
1637               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
1638                 if (auto *resolvedObject{
1639                         ResolveOmp(*object, ompFlag, currScope())}) {
1640                   if (dataCopyingAttributeFlags.test(ompFlag)) {
1641                     CheckDataCopyingClause(name, *resolvedObject, ompFlag);
1642                   } else {
1643                     AddToContextObjectWithDSA(*resolvedObject, ompFlag);
1644                   }
1645                 }
1646               }
1647             } else {
1648               context_.Say(name.source, // 2.15.3
1649                   "COMMON block must be declared in the same scoping unit "
1650                   "in which the OpenMP directive or clause appears"_err_en_US);
1651             }
1652           },
1653       },
1654       ompObject.u);
1655 }
1656 
ResolveOmp(const parser::Name & name,Symbol::Flag ompFlag,Scope & scope)1657 Symbol *OmpAttributeVisitor::ResolveOmp(
1658     const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {
1659   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1660     return DeclarePrivateAccessEntity(name, ompFlag, scope);
1661   } else {
1662     return DeclareOrMarkOtherAccessEntity(name, ompFlag);
1663   }
1664 }
1665 
ResolveOmp(Symbol & symbol,Symbol::Flag ompFlag,Scope & scope)1666 Symbol *OmpAttributeVisitor::ResolveOmp(
1667     Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {
1668   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1669     return DeclarePrivateAccessEntity(symbol, ompFlag, scope);
1670   } else {
1671     return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
1672   }
1673 }
1674 
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag ompFlag)1675 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1676     const parser::Name &name, Symbol::Flag ompFlag) {
1677   Symbol *prev{currScope().FindSymbol(name.source)};
1678   if (!name.symbol || !prev) {
1679     return nullptr;
1680   } else if (prev != name.symbol) {
1681     name.symbol = prev;
1682   }
1683   return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
1684 }
1685 
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag ompFlag)1686 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1687     Symbol &object, Symbol::Flag ompFlag) {
1688   if (ompFlagsRequireMark.test(ompFlag)) {
1689     object.set(ompFlag);
1690   }
1691   return &object;
1692 }
1693 
WithMultipleAppearancesOmpException(const Symbol & symbol,Symbol::Flag flag)1694 static bool WithMultipleAppearancesOmpException(
1695     const Symbol &symbol, Symbol::Flag flag) {
1696   return (flag == Symbol::Flag::OmpFirstPrivate &&
1697              symbol.test(Symbol::Flag::OmpLastPrivate)) ||
1698       (flag == Symbol::Flag::OmpLastPrivate &&
1699           symbol.test(Symbol::Flag::OmpFirstPrivate));
1700 }
1701 
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1702 void OmpAttributeVisitor::CheckMultipleAppearances(
1703     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1704   const auto *target{&symbol};
1705   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1706     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
1707       target = &details->symbol();
1708     }
1709   }
1710   if (HasDataSharingAttributeObject(*target) &&
1711       !WithMultipleAppearancesOmpException(symbol, ompFlag)) {
1712     context_.Say(name.source,
1713         "'%s' appears in more than one data-sharing clause "
1714         "on the same OpenMP directive"_err_en_US,
1715         name.ToString());
1716   } else {
1717     AddDataSharingAttributeObject(*target);
1718     if (privateDataSharingAttributeFlags.test(ompFlag)) {
1719       AddPrivateDataSharingAttributeObjects(*target);
1720     }
1721   }
1722 }
1723 
ResolveAccParts(SemanticsContext & context,const parser::ProgramUnit & node)1724 void ResolveAccParts(
1725     SemanticsContext &context, const parser::ProgramUnit &node) {
1726   if (context.IsEnabled(common::LanguageFeature::OpenACC)) {
1727     AccAttributeVisitor{context}.Walk(node);
1728   }
1729 }
1730 
ResolveOmpParts(SemanticsContext & context,const parser::ProgramUnit & node)1731 void ResolveOmpParts(
1732     SemanticsContext &context, const parser::ProgramUnit &node) {
1733   if (context.IsEnabled(common::LanguageFeature::OpenMP)) {
1734     OmpAttributeVisitor{context}.Walk(node);
1735     if (!context.AnyFatalError()) {
1736       // The data-sharing attribute of the loop iteration variable for a
1737       // sequential loop (2.15.1.1) can only be determined when visiting
1738       // the corresponding DoConstruct, a second walk is to adjust the
1739       // symbols for all the data-refs of that loop iteration variable
1740       // prior to the DoConstruct.
1741       OmpAttributeVisitor{context}.Walk(node);
1742     }
1743   }
1744 }
1745 
CheckDataCopyingClause(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1746 void OmpAttributeVisitor::CheckDataCopyingClause(
1747     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1748   const auto *checkSymbol{&symbol};
1749   if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
1750     checkSymbol = &details->symbol();
1751   }
1752 
1753   if (ompFlag == Symbol::Flag::OmpCopyIn) {
1754     // List of items/objects that can appear in a 'copyin' clause must be
1755     // 'threadprivate'
1756     if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate)) {
1757       context_.Say(name.source,
1758           "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
1759           checkSymbol->name());
1760     }
1761   } else if (ompFlag == Symbol::Flag::OmpCopyPrivate &&
1762       GetContext().directive == llvm::omp::Directive::OMPD_single) {
1763     // A list item that appears in a 'copyprivate' clause may not appear on a
1764     // 'private' or 'firstprivate' clause on a single construct
1765     if (IsObjectWithDSA(symbol) &&
1766         (symbol.test(Symbol::Flag::OmpPrivate) ||
1767             symbol.test(Symbol::Flag::OmpFirstPrivate))) {
1768       context_.Say(name.source,
1769           "COPYPRIVATE variable '%s' may not appear on a PRIVATE or "
1770           "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US,
1771           symbol.name());
1772     } else {
1773       // List of items/objects that can appear in a 'copyprivate' clause must be
1774       // either 'private' or 'threadprivate' in enclosing context.
1775       if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate) &&
1776           !(HasSymbolInEnclosingScope(symbol, currScope()) &&
1777               symbol.test(Symbol::Flag::OmpPrivate))) {
1778         context_.Say(name.source,
1779             "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "
1780             "outer context"_err_en_US,
1781             symbol.name());
1782       }
1783     }
1784   }
1785 }
1786 
CheckObjectInNamelist(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1787 void OmpAttributeVisitor::CheckObjectInNamelist(
1788     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1789   const auto &ultimateSymbol{symbol.GetUltimate()};
1790   llvm::StringRef clauseName{"PRIVATE"};
1791   if (ompFlag == Symbol::Flag::OmpFirstPrivate) {
1792     clauseName = "FIRSTPRIVATE";
1793   } else if (ompFlag == Symbol::Flag::OmpLastPrivate) {
1794     clauseName = "LASTPRIVATE";
1795   }
1796 
1797   if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
1798     context_.Say(name.source,
1799         "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
1800         name.ToString(), clauseName.str());
1801   }
1802 }
1803 
CheckSourceLabel(const parser::Label & label)1804 void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) {
1805   // Get the context to check if the statement causing a jump to the 'label' is
1806   // in an enclosing OpenMP construct
1807   std::optional<DirContext> thisContext{GetContextIf()};
1808   sourceLabels_.emplace(
1809       label, std::make_pair(currentStatementSource_, thisContext));
1810   // Check if the statement with 'label' to which a jump is being introduced
1811   // has already been encountered
1812   auto it{targetLabels_.find(label)};
1813   if (it != targetLabels_.end()) {
1814     // Check if both the statement with 'label' and the statement that causes a
1815     // jump to the 'label' are in the same scope
1816     CheckLabelContext(currentStatementSource_, it->second.first, thisContext,
1817         it->second.second);
1818   }
1819 }
1820 
1821 // Check for invalid branch into or out of OpenMP structured blocks
CheckLabelContext(const parser::CharBlock source,const parser::CharBlock target,std::optional<DirContext> sourceContext,std::optional<DirContext> targetContext)1822 void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source,
1823     const parser::CharBlock target, std::optional<DirContext> sourceContext,
1824     std::optional<DirContext> targetContext) {
1825   if (targetContext &&
1826       (!sourceContext ||
1827           (sourceContext->scope != targetContext->scope &&
1828               !DoesScopeContain(
1829                   &targetContext->scope, sourceContext->scope)))) {
1830     context_
1831         .Say(source, "invalid branch into an OpenMP structured block"_err_en_US)
1832         .Attach(target, "In the enclosing %s directive branched into"_en_US,
1833             parser::ToUpperCaseLetters(
1834                 llvm::omp::getOpenMPDirectiveName(targetContext->directive)
1835                     .str()));
1836   }
1837   if (sourceContext &&
1838       (!targetContext ||
1839           (sourceContext->scope != targetContext->scope &&
1840               !DoesScopeContain(
1841                   &sourceContext->scope, targetContext->scope)))) {
1842     context_
1843         .Say(source,
1844             "invalid branch leaving an OpenMP structured block"_err_en_US)
1845         .Attach(target, "Outside the enclosing %s directive"_en_US,
1846             parser::ToUpperCaseLetters(
1847                 llvm::omp::getOpenMPDirectiveName(sourceContext->directive)
1848                     .str()));
1849   }
1850 }
1851 
HasSymbolInEnclosingScope(const Symbol & symbol,Scope & scope)1852 bool OmpAttributeVisitor::HasSymbolInEnclosingScope(
1853     const Symbol &symbol, Scope &scope) {
1854   const auto symbols{scope.parent().GetSymbols()};
1855   auto it{std::find(symbols.begin(), symbols.end(), symbol)};
1856   return it != symbols.end();
1857 }
1858 
1859 } // namespace Fortran::semantics
1860