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   }
PushContext(const parser::CharBlock & source,T dir)51   void PushContext(const parser::CharBlock &source, T dir) {
52     dirContext_.emplace_back(source, dir, context_.FindScope(source));
53   }
PopContext()54   void PopContext() { dirContext_.pop_back(); }
SetContextDirectiveSource(parser::CharBlock & dir)55   void SetContextDirectiveSource(parser::CharBlock &dir) {
56     GetContext().directiveSource = dir;
57   }
currScope()58   Scope &currScope() { return GetContext().scope; }
SetContextDefaultDSA(Symbol::Flag flag)59   void SetContextDefaultDSA(Symbol::Flag flag) {
60     GetContext().defaultDSA = flag;
61   }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag,DirContext & context)62   void AddToContextObjectWithDSA(
63       const Symbol &symbol, Symbol::Flag flag, DirContext &context) {
64     context.objectWithDSA.emplace(&symbol, flag);
65   }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag)66   void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
67     AddToContextObjectWithDSA(symbol, flag, GetContext());
68   }
IsObjectWithDSA(const Symbol & symbol)69   bool IsObjectWithDSA(const Symbol &symbol) {
70     auto it{GetContext().objectWithDSA.find(&symbol)};
71     return it != GetContext().objectWithDSA.end();
72   }
SetContextAssociatedLoopLevel(std::int64_t level)73   void SetContextAssociatedLoopLevel(std::int64_t level) {
74     GetContext().associatedLoopLevel = level;
75   }
MakeAssocSymbol(const SourceName & name,Symbol & prev,Scope & scope)76   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev, Scope &scope) {
77     const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
78     return *pair.first->second;
79   }
MakeAssocSymbol(const SourceName & name,Symbol & prev)80   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
81     return MakeAssocSymbol(name, prev, currScope());
82   }
GetDesignatorNameIfDataRef(const parser::Designator & designator)83   static const parser::Name *GetDesignatorNameIfDataRef(
84       const parser::Designator &designator) {
85     const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
86     return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
87   }
AddDataSharingAttributeObject(SymbolRef object)88   void AddDataSharingAttributeObject(SymbolRef object) {
89     dataSharingAttributeObjects_.insert(object);
90   }
ClearDataSharingAttributeObjects()91   void ClearDataSharingAttributeObjects() {
92     dataSharingAttributeObjects_.clear();
93   }
94   bool HasDataSharingAttributeObject(const Symbol &);
95   const parser::Name &GetLoopIndex(const parser::DoConstruct &);
96   const parser::DoConstruct *GetDoConstructIf(
97       const parser::ExecutionPartConstruct &);
98   Symbol *DeclarePrivateAccessEntity(
99       const parser::Name &, Symbol::Flag, Scope &);
100   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &);
101   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
102 
103   SymbolSet dataSharingAttributeObjects_; // on one directive
104   SemanticsContext &context_;
105   std::vector<DirContext> dirContext_; // used as a stack
106 };
107 
108 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
109 public:
AccAttributeVisitor(SemanticsContext & context)110   explicit AccAttributeVisitor(SemanticsContext &context)
111       : DirectiveAttributeVisitor(context) {}
112 
Walk(const A & x)113   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)114   template <typename A> bool Pre(const A &) { return true; }
Post(const A &)115   template <typename A> void Post(const A &) {}
116 
Pre(const parser::SpecificationPart & x)117   bool Pre(const parser::SpecificationPart &x) {
118     Walk(std::get<std::list<parser::OpenACCDeclarativeConstruct>>(x.t));
119     return false;
120   }
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 
Post(const parser::AccBeginBlockDirective &)127   void Post(const parser::AccBeginBlockDirective &) {
128     GetContext().withinConstruct = true;
129   }
130 
131   bool Pre(const parser::OpenACCLoopConstruct &);
Post(const parser::OpenACCLoopConstruct &)132   void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
Post(const parser::AccLoopDirective &)133   void Post(const parser::AccLoopDirective &) {
134     GetContext().withinConstruct = true;
135   }
136 
137   bool Pre(const parser::OpenACCStandaloneConstruct &);
Post(const parser::OpenACCStandaloneConstruct &)138   void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
Post(const parser::AccStandaloneDirective &)139   void Post(const parser::AccStandaloneDirective &) {
140     GetContext().withinConstruct = true;
141   }
142 
143   bool Pre(const parser::OpenACCCacheConstruct &);
Post(const parser::OpenACCCacheConstruct &)144   void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
145 
146   void Post(const parser::AccDefaultClause &);
147 
Pre(const parser::AccClause::Copy & x)148   bool Pre(const parser::AccClause::Copy &x) {
149     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
150     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
151     return false;
152   }
153 
Pre(const parser::AccClause::Create & x)154   bool Pre(const parser::AccClause::Create &x) {
155     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
156     ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);
157     return false;
158   }
159 
Pre(const parser::AccClause::Copyin & x)160   bool Pre(const parser::AccClause::Copyin &x) {
161     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
162     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);
163     return false;
164   }
165 
Pre(const parser::AccClause::Copyout & x)166   bool Pre(const parser::AccClause::Copyout &x) {
167     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
168     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);
169     return false;
170   }
171 
Pre(const parser::AccClause::Present & x)172   bool Pre(const parser::AccClause::Present &x) {
173     ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);
174     return false;
175   }
Pre(const parser::AccClause::Private & x)176   bool Pre(const parser::AccClause::Private &x) {
177     ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);
178     return false;
179   }
Pre(const parser::AccClause::Firstprivate & x)180   bool Pre(const parser::AccClause::Firstprivate &x) {
181     ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);
182     return false;
183   }
184 
185   void Post(const parser::Name &);
186 
187 private:
188   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
189 
190   static constexpr Symbol::Flags dataSharingAttributeFlags{
191       Symbol::Flag::AccShared, Symbol::Flag::AccPrivate,
192       Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate,
193       Symbol::Flag::AccReduction};
194 
195   static constexpr Symbol::Flags dataMappingAttributeFlags{
196       Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn,
197       Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete};
198 
199   static constexpr Symbol::Flags accFlagsRequireNewSymbol{
200       Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,
201       Symbol::Flag::AccReduction};
202 
203   static constexpr Symbol::Flags accFlagsRequireMark{};
204 
205   void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &);
206   void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
207   void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
208   Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
209   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
210   Symbol *ResolveAccCommonBlockName(const parser::Name *);
211   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
212   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
213   void CheckMultipleAppearances(
214       const parser::Name &, const Symbol &, Symbol::Flag);
215   void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
216 };
217 
218 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
219 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
220 public:
OmpAttributeVisitor(SemanticsContext & context)221   explicit OmpAttributeVisitor(SemanticsContext &context)
222       : DirectiveAttributeVisitor(context) {}
223 
Walk(const A & x)224   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)225   template <typename A> bool Pre(const A &) { return true; }
Post(const A &)226   template <typename A> void Post(const A &) {}
227 
Pre(const parser::SpecificationPart & x)228   bool Pre(const parser::SpecificationPart &x) {
229     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
230     return true;
231   }
232 
233   bool Pre(const parser::OpenMPBlockConstruct &);
234   void Post(const parser::OpenMPBlockConstruct &);
235 
Post(const parser::OmpBeginBlockDirective &)236   void Post(const parser::OmpBeginBlockDirective &) {
237     GetContext().withinConstruct = true;
238   }
239 
240   bool Pre(const parser::OpenMPLoopConstruct &);
Post(const parser::OpenMPLoopConstruct &)241   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
Post(const parser::OmpBeginLoopDirective &)242   void Post(const parser::OmpBeginLoopDirective &) {
243     GetContext().withinConstruct = true;
244   }
245   bool Pre(const parser::DoConstruct &);
246 
247   bool Pre(const parser::OpenMPSectionsConstruct &);
Post(const parser::OpenMPSectionsConstruct &)248   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
249 
Pre(const parser::OpenMPDeclareSimdConstruct & x)250   bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
251     PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd);
252     const auto &name{std::get<std::optional<parser::Name>>(x.t)};
253     if (name) {
254       ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd);
255     }
256     return true;
257   }
Post(const parser::OpenMPDeclareSimdConstruct &)258   void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }
259   bool Pre(const parser::OpenMPThreadprivate &);
Post(const parser::OpenMPThreadprivate &)260   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
261 
262   // 2.15.3 Data-Sharing Attribute Clauses
263   void Post(const parser::OmpDefaultClause &);
Pre(const parser::OmpClause::Shared & x)264   bool Pre(const parser::OmpClause::Shared &x) {
265     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
266     return false;
267   }
Pre(const parser::OmpClause::Private & x)268   bool Pre(const parser::OmpClause::Private &x) {
269     ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
270     return false;
271   }
Pre(const parser::OmpAllocateClause & x)272   bool Pre(const parser::OmpAllocateClause &x) {
273     const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
274     ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate);
275     return false;
276   }
Pre(const parser::OmpClause::Firstprivate & x)277   bool Pre(const parser::OmpClause::Firstprivate &x) {
278     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
279     return false;
280   }
Pre(const parser::OmpClause::Lastprivate & x)281   bool Pre(const parser::OmpClause::Lastprivate &x) {
282     ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
283     return false;
284   }
Pre(const parser::OmpClause::Copyin & x)285   bool Pre(const parser::OmpClause::Copyin &x) {
286     ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);
287     return false;
288   }
Pre(const parser::OmpLinearClause & x)289   bool Pre(const parser::OmpLinearClause &x) {
290     std::visit(common::visitors{
291                    [&](const parser::OmpLinearClause::WithoutModifier
292                            &linearWithoutModifier) {
293                      ResolveOmpNameList(
294                          linearWithoutModifier.names, Symbol::Flag::OmpLinear);
295                    },
296                    [&](const parser::OmpLinearClause::WithModifier
297                            &linearWithModifier) {
298                      ResolveOmpNameList(
299                          linearWithModifier.names, Symbol::Flag::OmpLinear);
300                    },
301                },
302         x.u);
303     return false;
304   }
Pre(const parser::OmpAlignedClause & x)305   bool Pre(const parser::OmpAlignedClause &x) {
306     const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)};
307     ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned);
308     return false;
309   }
310   void Post(const parser::Name &);
311 
312   const parser::OmpClause *associatedClause{nullptr};
SetAssociatedClause(const parser::OmpClause & c)313   void SetAssociatedClause(const parser::OmpClause &c) {
314     associatedClause = &c;
315   }
GetAssociatedClause()316   const parser::OmpClause *GetAssociatedClause() { return associatedClause; }
317 
318 private:
319   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
320 
321   static constexpr Symbol::Flags dataSharingAttributeFlags{
322       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
323       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
324       Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
325 
326   static constexpr Symbol::Flags privateDataSharingAttributeFlags{
327       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
328       Symbol::Flag::OmpLastPrivate};
329 
330   static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
331       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
332       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
333       Symbol::Flag::OmpReduction};
334 
335   static constexpr Symbol::Flags ompFlagsRequireMark{
336       Symbol::Flag::OmpThreadprivate};
337 
338   static constexpr Symbol::Flags dataCopyingAttributeFlags{
339       Symbol::Flag::OmpCopyIn};
340 
341   std::vector<const parser::Name *> allocateNames_; // on one directive
342   SymbolSet privateDataSharingAttributeObjects_; // on one directive
343 
AddAllocateName(const parser::Name * & object)344   void AddAllocateName(const parser::Name *&object) {
345     allocateNames_.push_back(object);
346   }
ClearAllocateNames()347   void ClearAllocateNames() { allocateNames_.clear(); }
348 
AddPrivateDataSharingAttributeObjects(SymbolRef object)349   void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
350     privateDataSharingAttributeObjects_.insert(object);
351   }
ClearPrivateDataSharingAttributeObjects()352   void ClearPrivateDataSharingAttributeObjects() {
353     privateDataSharingAttributeObjects_.clear();
354   }
355 
356   // Predetermined DSA rules
357   void PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
358       const parser::OpenMPLoopConstruct &);
359   void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
360 
361   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
362   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
363   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
364   Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
365   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
366   void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
367   void ResolveOmpName(const parser::Name &, Symbol::Flag);
368   Symbol *ResolveName(const parser::Name *);
369   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
370   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
371   void CheckMultipleAppearances(
372       const parser::Name &, const Symbol &, Symbol::Flag);
373 
374   void CheckDataCopyingClause(
375       const parser::Name &, const Symbol &, Symbol::Flag);
376 
377   void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);
378   void CheckObjectInNamelist(
379       const parser::Name &, const Symbol &, Symbol::Flag);
380 };
381 
382 template <typename T>
HasDataSharingAttributeObject(const Symbol & object)383 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
384     const Symbol &object) {
385   auto it{dataSharingAttributeObjects_.find(object)};
386   return it != dataSharingAttributeObjects_.end();
387 }
388 
389 template <typename T>
GetLoopIndex(const parser::DoConstruct & x)390 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex(
391     const parser::DoConstruct &x) {
392   using Bounds = parser::LoopControl::Bounds;
393   return std::get<Bounds>(x.GetLoopControl()->u).name.thing;
394 }
395 
396 template <typename T>
GetDoConstructIf(const parser::ExecutionPartConstruct & x)397 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(
398     const parser::ExecutionPartConstruct &x) {
399   return parser::Unwrap<parser::DoConstruct>(x);
400 }
401 
402 template <typename T>
DeclarePrivateAccessEntity(const parser::Name & name,Symbol::Flag flag,Scope & scope)403 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
404     const parser::Name &name, Symbol::Flag flag, Scope &scope) {
405   if (!name.symbol) {
406     return nullptr; // not resolved by Name Resolution step, do nothing
407   }
408   name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope);
409   return name.symbol;
410 }
411 
412 template <typename T>
DeclarePrivateAccessEntity(Symbol & object,Symbol::Flag flag,Scope & scope)413 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
414     Symbol &object, Symbol::Flag flag, Scope &scope) {
415   if (object.owner() != currScope()) {
416     auto &symbol{MakeAssocSymbol(object.name(), object, scope)};
417     symbol.set(flag);
418     return &symbol;
419   } else {
420     object.set(flag);
421     return &object;
422   }
423 }
424 
Pre(const parser::OpenACCBlockConstruct & x)425 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
426   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
427   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
428   switch (blockDir.v) {
429   case llvm::acc::Directive::ACCD_data:
430   case llvm::acc::Directive::ACCD_host_data:
431   case llvm::acc::Directive::ACCD_kernels:
432   case llvm::acc::Directive::ACCD_parallel:
433   case llvm::acc::Directive::ACCD_serial:
434     PushContext(blockDir.source, blockDir.v);
435     break;
436   default:
437     break;
438   }
439   ClearDataSharingAttributeObjects();
440   return true;
441 }
442 
Pre(const parser::OpenACCLoopConstruct & x)443 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
444   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
445   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
446   const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
447   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
448     PushContext(loopDir.source, loopDir.v);
449   }
450   ClearDataSharingAttributeObjects();
451   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
452   PrivatizeAssociatedLoopIndex(x);
453   return true;
454 }
455 
Pre(const parser::OpenACCStandaloneConstruct & x)456 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
457   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
458   switch (standaloneDir.v) {
459   case llvm::acc::Directive::ACCD_enter_data:
460   case llvm::acc::Directive::ACCD_exit_data:
461   case llvm::acc::Directive::ACCD_init:
462   case llvm::acc::Directive::ACCD_set:
463   case llvm::acc::Directive::ACCD_shutdown:
464   case llvm::acc::Directive::ACCD_update:
465     PushContext(standaloneDir.source, standaloneDir.v);
466     break;
467   default:
468     break;
469   }
470   ClearDataSharingAttributeObjects();
471   return true;
472 }
473 
Pre(const parser::OpenACCCombinedConstruct & x)474 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
475   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
476   const auto &combinedDir{
477       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
478   switch (combinedDir.v) {
479   case llvm::acc::Directive::ACCD_kernels_loop:
480   case llvm::acc::Directive::ACCD_parallel_loop:
481   case llvm::acc::Directive::ACCD_serial_loop:
482     PushContext(combinedDir.source, combinedDir.v);
483     break;
484   default:
485     break;
486   }
487   ClearDataSharingAttributeObjects();
488   return true;
489 }
490 
IsLastNameArray(const parser::Designator & designator)491 static bool IsLastNameArray(const parser::Designator &designator) {
492   const auto &name{GetLastName(designator)};
493   const evaluate::DataRef dataRef{*(name.symbol)};
494   return std::visit(
495       common::visitors{
496           [](const evaluate::SymbolRef &ref) { return ref->Rank() > 0; },
497           [](const evaluate::ArrayRef &aref) {
498             return aref.base().IsSymbol() ||
499                 aref.base().GetComponent().base().Rank() == 0;
500           },
501           [](const auto &) { return false; },
502       },
503       dataRef.u);
504 }
505 
AllowOnlyArrayAndSubArray(const parser::AccObjectList & objectList)506 void AccAttributeVisitor::AllowOnlyArrayAndSubArray(
507     const parser::AccObjectList &objectList) {
508   for (const auto &accObject : objectList.v) {
509     std::visit(
510         common::visitors{
511             [&](const parser::Designator &designator) {
512               if (!IsLastNameArray(designator))
513                 context_.Say(designator.source,
514                     "Only array element or subarray are allowed in %s directive"_err_en_US,
515                     parser::ToUpperCaseLetters(
516                         llvm::acc::getOpenACCDirectiveName(
517                             GetContext().directive)
518                             .str()));
519             },
520             [&](const auto &name) {
521               context_.Say(name.source,
522                   "Only array element or subarray are allowed in %s directive"_err_en_US,
523                   parser::ToUpperCaseLetters(
524                       llvm::acc::getOpenACCDirectiveName(GetContext().directive)
525                           .str()));
526             },
527         },
528         accObject.u);
529   }
530 }
531 
Pre(const parser::OpenACCCacheConstruct & x)532 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
533   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
534   PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
535   ClearDataSharingAttributeObjects();
536 
537   const auto &objectListWithModifier =
538       std::get<parser::AccObjectListWithModifier>(x.t);
539   const auto &objectList =
540       std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);
541 
542   // 2.10 Cache directive restriction: A var in a cache directive must be a
543   // single array element or a simple subarray.
544   AllowOnlyArrayAndSubArray(objectList);
545 
546   return true;
547 }
548 
GetAssociatedLoopLevelFromClauses(const parser::AccClauseList & x)549 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
550     const parser::AccClauseList &x) {
551   std::int64_t collapseLevel{0};
552   for (const auto &clause : x.v) {
553     if (const auto *collapseClause{
554             std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
555       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
556         collapseLevel = *v;
557       }
558     }
559   }
560 
561   if (collapseLevel) {
562     return collapseLevel;
563   }
564   return 1; // default is outermost loop
565 }
566 
PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct & x)567 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex(
568     const parser::OpenACCLoopConstruct &x) {
569   std::int64_t level{GetContext().associatedLoopLevel};
570   if (level <= 0) { // collpase value was negative or 0
571     return;
572   }
573   Symbol::Flag ivDSA{Symbol::Flag::AccPrivate};
574 
575   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
576   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
577     // go through all the nested do-loops and resolve index variables
578     const parser::Name &iv{GetLoopIndex(*loop)};
579     if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) {
580       symbol->set(Symbol::Flag::AccPreDetermined);
581       iv.symbol = symbol; // adjust the symbol within region
582       AddToContextObjectWithDSA(*symbol, ivDSA);
583     }
584 
585     const auto &block{std::get<parser::Block>(loop->t)};
586     const auto it{block.begin()};
587     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
588   }
589   CHECK(level == 0);
590 }
591 
Post(const parser::AccDefaultClause & x)592 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
593   if (!dirContext_.empty()) {
594     switch (x.v) {
595     case parser::AccDefaultClause::Arg::Present:
596       SetContextDefaultDSA(Symbol::Flag::AccPresent);
597       break;
598     case parser::AccDefaultClause::Arg::None:
599       SetContextDefaultDSA(Symbol::Flag::AccNone);
600       break;
601     }
602   }
603 }
604 
605 // For OpenACC constructs, check all the data-refs within the constructs
606 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)607 void AccAttributeVisitor::Post(const parser::Name &name) {
608   auto *symbol{name.symbol};
609   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
610     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
611         !IsObjectWithDSA(*symbol)) {
612       if (Symbol * found{currScope().FindSymbol(name.source)}) {
613         if (symbol != found) {
614           name.symbol = found; // adjust the symbol within region
615         } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
616           // 2.5.14.
617           context_.Say(name.source,
618               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
619               "a data-mapping clause"_err_en_US,
620               symbol->name());
621         }
622       }
623     }
624   } // within OpenACC construct
625 }
626 
ResolveAccCommonBlockName(const parser::Name * name)627 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
628     const parser::Name *name) {
629   if (!name) {
630     return nullptr;
631   } else if (auto *prev{
632                  GetContext().scope.parent().FindCommonBlock(name->source)}) {
633     name->symbol = prev;
634     return prev;
635   } else {
636     return nullptr;
637   }
638 }
639 
ResolveAccObjectList(const parser::AccObjectList & accObjectList,Symbol::Flag accFlag)640 void AccAttributeVisitor::ResolveAccObjectList(
641     const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
642   for (const auto &accObject : accObjectList.v) {
643     ResolveAccObject(accObject, accFlag);
644   }
645 }
646 
ResolveAccObject(const parser::AccObject & accObject,Symbol::Flag accFlag)647 void AccAttributeVisitor::ResolveAccObject(
648     const parser::AccObject &accObject, Symbol::Flag accFlag) {
649   std::visit(
650       common::visitors{
651           [&](const parser::Designator &designator) {
652             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
653               if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {
654                 AddToContextObjectWithDSA(*symbol, accFlag);
655                 if (dataSharingAttributeFlags.test(accFlag)) {
656                   CheckMultipleAppearances(*name, *symbol, accFlag);
657                 }
658               }
659             } else {
660               // Array sections to be changed to substrings as needed
661               if (AnalyzeExpr(context_, designator)) {
662                 if (std::holds_alternative<parser::Substring>(designator.u)) {
663                   context_.Say(designator.source,
664                       "Substrings are not allowed on OpenACC "
665                       "directives or clauses"_err_en_US);
666                 }
667               }
668               // other checks, more TBD
669             }
670           },
671           [&](const parser::Name &name) { // common block
672             if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
673               CheckMultipleAppearances(
674                   name, *symbol, Symbol::Flag::AccCommonBlock);
675               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
676                 if (auto *resolvedObject{
677                         ResolveAcc(*object, accFlag, currScope())}) {
678                   AddToContextObjectWithDSA(*resolvedObject, accFlag);
679                 }
680               }
681             } else {
682               context_.Say(name.source,
683                   "COMMON block must be declared in the same scoping unit "
684                   "in which the OpenACC directive or clause appears"_err_en_US);
685             }
686           },
687       },
688       accObject.u);
689 }
690 
ResolveAcc(const parser::Name & name,Symbol::Flag accFlag,Scope & scope)691 Symbol *AccAttributeVisitor::ResolveAcc(
692     const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
693   if (accFlagsRequireNewSymbol.test(accFlag)) {
694     return DeclarePrivateAccessEntity(name, accFlag, scope);
695   } else {
696     return DeclareOrMarkOtherAccessEntity(name, accFlag);
697   }
698 }
699 
ResolveAcc(Symbol & symbol,Symbol::Flag accFlag,Scope & scope)700 Symbol *AccAttributeVisitor::ResolveAcc(
701     Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
702   if (accFlagsRequireNewSymbol.test(accFlag)) {
703     return DeclarePrivateAccessEntity(symbol, accFlag, scope);
704   } else {
705     return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
706   }
707 }
708 
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag accFlag)709 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
710     const parser::Name &name, Symbol::Flag accFlag) {
711   Symbol *prev{currScope().FindSymbol(name.source)};
712   if (!name.symbol || !prev) {
713     return nullptr;
714   } else if (prev != name.symbol) {
715     name.symbol = prev;
716   }
717   return DeclareOrMarkOtherAccessEntity(*prev, accFlag);
718 }
719 
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag accFlag)720 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
721     Symbol &object, Symbol::Flag accFlag) {
722   if (accFlagsRequireMark.test(accFlag)) {
723     object.set(accFlag);
724   }
725   return &object;
726 }
727 
WithMultipleAppearancesAccException(const Symbol & symbol,Symbol::Flag flag)728 static bool WithMultipleAppearancesAccException(
729     const Symbol &symbol, Symbol::Flag flag) {
730   return false; // Place holder
731 }
732 
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag accFlag)733 void AccAttributeVisitor::CheckMultipleAppearances(
734     const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {
735   const auto *target{&symbol};
736   if (accFlagsRequireNewSymbol.test(accFlag)) {
737     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
738       target = &details->symbol();
739     }
740   }
741   if (HasDataSharingAttributeObject(*target) &&
742       !WithMultipleAppearancesAccException(symbol, accFlag)) {
743     context_.Say(name.source,
744         "'%s' appears in more than one data-sharing clause "
745         "on the same OpenACC directive"_err_en_US,
746         name.ToString());
747   } else {
748     AddDataSharingAttributeObject(*target);
749   }
750 }
751 
Pre(const parser::OpenMPBlockConstruct & x)752 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
753   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
754   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
755   switch (beginDir.v) {
756   case llvm::omp::Directive::OMPD_master:
757   case llvm::omp::Directive::OMPD_ordered:
758   case llvm::omp::Directive::OMPD_parallel:
759   case llvm::omp::Directive::OMPD_single:
760   case llvm::omp::Directive::OMPD_target:
761   case llvm::omp::Directive::OMPD_target_data:
762   case llvm::omp::Directive::OMPD_task:
763   case llvm::omp::Directive::OMPD_teams:
764   case llvm::omp::Directive::OMPD_workshare:
765   case llvm::omp::Directive::OMPD_parallel_workshare:
766   case llvm::omp::Directive::OMPD_target_teams:
767   case llvm::omp::Directive::OMPD_target_parallel:
768     PushContext(beginDir.source, beginDir.v);
769     break;
770   default:
771     // TODO others
772     break;
773   }
774   ClearDataSharingAttributeObjects();
775   ClearPrivateDataSharingAttributeObjects();
776   ClearAllocateNames();
777   return true;
778 }
779 
Post(const parser::OpenMPBlockConstruct & x)780 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) {
781   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
782   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
783   switch (beginDir.v) {
784   case llvm::omp::Directive::OMPD_parallel:
785   case llvm::omp::Directive::OMPD_single:
786   case llvm::omp::Directive::OMPD_target:
787   case llvm::omp::Directive::OMPD_task:
788   case llvm::omp::Directive::OMPD_teams:
789   case llvm::omp::Directive::OMPD_parallel_workshare:
790   case llvm::omp::Directive::OMPD_target_teams:
791   case llvm::omp::Directive::OMPD_target_parallel: {
792     bool hasPrivate;
793     for (const auto *allocName : allocateNames_) {
794       hasPrivate = false;
795       for (auto privateObj : privateDataSharingAttributeObjects_) {
796         const Symbol &symbolPrivate{*privateObj};
797         if (allocName->source == symbolPrivate.name()) {
798           hasPrivate = true;
799           break;
800         }
801       }
802       if (!hasPrivate) {
803         context_.Say(allocName->source,
804             "The ALLOCATE clause requires that '%s' must be listed in a "
805             "private "
806             "data-sharing attribute clause on the same directive"_err_en_US,
807             allocName->ToString());
808       }
809     }
810     break;
811   }
812   default:
813     break;
814   }
815   PopContext();
816 }
817 
Pre(const parser::OpenMPLoopConstruct & x)818 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
819   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
820   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
821   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
822   switch (beginDir.v) {
823   case llvm::omp::Directive::OMPD_distribute:
824   case llvm::omp::Directive::OMPD_distribute_parallel_do:
825   case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
826   case llvm::omp::Directive::OMPD_distribute_simd:
827   case llvm::omp::Directive::OMPD_do:
828   case llvm::omp::Directive::OMPD_do_simd:
829   case llvm::omp::Directive::OMPD_parallel_do:
830   case llvm::omp::Directive::OMPD_parallel_do_simd:
831   case llvm::omp::Directive::OMPD_simd:
832   case llvm::omp::Directive::OMPD_target_parallel_do:
833   case llvm::omp::Directive::OMPD_target_parallel_do_simd:
834   case llvm::omp::Directive::OMPD_target_teams_distribute:
835   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
836   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
837   case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
838   case llvm::omp::Directive::OMPD_target_simd:
839   case llvm::omp::Directive::OMPD_taskloop:
840   case llvm::omp::Directive::OMPD_taskloop_simd:
841   case llvm::omp::Directive::OMPD_teams_distribute:
842   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
843   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
844   case llvm::omp::Directive::OMPD_teams_distribute_simd:
845     PushContext(beginDir.source, beginDir.v);
846     break;
847   default:
848     break;
849   }
850   ClearDataSharingAttributeObjects();
851   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
852   PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
853   return true;
854 }
855 
ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name & iv)856 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
857     const parser::Name &iv) {
858   auto targetIt{dirContext_.rbegin()};
859   for (;; ++targetIt) {
860     if (targetIt == dirContext_.rend()) {
861       return;
862     }
863     if (llvm::omp::parallelSet.test(targetIt->directive) ||
864         llvm::omp::taskGeneratingSet.test(targetIt->directive)) {
865       break;
866     }
867   }
868   if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {
869     targetIt++;
870     symbol->set(Symbol::Flag::OmpPreDetermined);
871     iv.symbol = symbol; // adjust the symbol within region
872     for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {
873       AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);
874     }
875   }
876 }
877 
878 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
879 //   - A loop iteration variable for a sequential loop in a parallel
880 //     or task generating construct is private in the innermost such
881 //     construct that encloses the loop
Pre(const parser::DoConstruct & x)882 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
883   if (!dirContext_.empty() && GetContext().withinConstruct) {
884     if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
885       if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
886         ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
887       } else {
888         // TODO: conflict checks with explicitly determined DSA
889       }
890     }
891   }
892   return true;
893 }
894 
GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList & x)895 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
896     const parser::OmpClauseList &x) {
897   std::int64_t orderedLevel{0};
898   std::int64_t collapseLevel{0};
899 
900   const parser::OmpClause *ordClause{nullptr};
901   const parser::OmpClause *collClause{nullptr};
902 
903   for (const auto &clause : x.v) {
904     if (const auto *orderedClause{
905             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
906       if (const auto v{EvaluateInt64(context_, orderedClause->v)}) {
907         orderedLevel = *v;
908       }
909       ordClause = &clause;
910     }
911     if (const auto *collapseClause{
912             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
913       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
914         collapseLevel = *v;
915       }
916       collClause = &clause;
917     }
918   }
919 
920   if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
921     SetAssociatedClause(*ordClause);
922     return orderedLevel;
923   } else if (!orderedLevel && collapseLevel) {
924     SetAssociatedClause(*collClause);
925     return collapseLevel;
926   } // orderedLevel < collapseLevel is an error handled in structural checks
927   return 1; // default is outermost loop
928 }
929 
930 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
931 //   - The loop iteration variable(s) in the associated do-loop(s) of a do,
932 //     parallel do, taskloop, or distribute construct is (are) private.
933 //   - The loop iteration variable in the associated do-loop of a simd construct
934 //     with just one associated do-loop is linear with a linear-step that is the
935 //     increment of the associated do-loop.
936 //   - The loop iteration variables in the associated do-loops of a simd
937 //     construct with multiple associated do-loops are lastprivate.
PrivatizeAssociatedLoopIndexAndCheckLoopLevel(const parser::OpenMPLoopConstruct & x)938 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
939     const parser::OpenMPLoopConstruct &x) {
940   std::int64_t level{GetContext().associatedLoopLevel};
941   if (level <= 0) {
942     return;
943   }
944   Symbol::Flag ivDSA;
945   if (!llvm::omp::simdSet.test(GetContext().directive)) {
946     ivDSA = Symbol::Flag::OmpPrivate;
947   } else if (level == 1) {
948     ivDSA = Symbol::Flag::OmpLinear;
949   } else {
950     ivDSA = Symbol::Flag::OmpLastPrivate;
951   }
952 
953   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
954   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
955     // go through all the nested do-loops and resolve index variables
956     const parser::Name &iv{GetLoopIndex(*loop)};
957     if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) {
958       symbol->set(Symbol::Flag::OmpPreDetermined);
959       iv.symbol = symbol; // adjust the symbol within region
960       AddToContextObjectWithDSA(*symbol, ivDSA);
961     }
962 
963     const auto &block{std::get<parser::Block>(loop->t)};
964     const auto it{block.begin()};
965     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
966   }
967   CheckAssocLoopLevel(level, GetAssociatedClause());
968 }
CheckAssocLoopLevel(std::int64_t level,const parser::OmpClause * clause)969 void OmpAttributeVisitor::CheckAssocLoopLevel(
970     std::int64_t level, const parser::OmpClause *clause) {
971   if (clause && level != 0) {
972     context_.Say(clause->source,
973         "The value of the parameter in the COLLAPSE or ORDERED clause must"
974         " not be larger than the number of nested loops"
975         " following the construct."_err_en_US);
976   }
977 }
978 
Pre(const parser::OpenMPSectionsConstruct & x)979 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
980   const auto &beginSectionsDir{
981       std::get<parser::OmpBeginSectionsDirective>(x.t)};
982   const auto &beginDir{
983       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
984   switch (beginDir.v) {
985   case llvm::omp::Directive::OMPD_parallel_sections:
986   case llvm::omp::Directive::OMPD_sections:
987     PushContext(beginDir.source, beginDir.v);
988     break;
989   default:
990     break;
991   }
992   ClearDataSharingAttributeObjects();
993   return true;
994 }
995 
Pre(const parser::OpenMPThreadprivate & x)996 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
997   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
998   const auto &list{std::get<parser::OmpObjectList>(x.t)};
999   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
1000   return true;
1001 }
1002 
Post(const parser::OmpDefaultClause & x)1003 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
1004   if (!dirContext_.empty()) {
1005     switch (x.v) {
1006     case parser::OmpDefaultClause::Type::Private:
1007       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
1008       break;
1009     case parser::OmpDefaultClause::Type::Firstprivate:
1010       SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
1011       break;
1012     case parser::OmpDefaultClause::Type::Shared:
1013       SetContextDefaultDSA(Symbol::Flag::OmpShared);
1014       break;
1015     case parser::OmpDefaultClause::Type::None:
1016       SetContextDefaultDSA(Symbol::Flag::OmpNone);
1017       break;
1018     }
1019   }
1020 }
1021 
1022 // For OpenMP constructs, check all the data-refs within the constructs
1023 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)1024 void OmpAttributeVisitor::Post(const parser::Name &name) {
1025   auto *symbol{name.symbol};
1026   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
1027     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
1028         !IsObjectWithDSA(*symbol)) {
1029       // TODO: create a separate function to go through the rules for
1030       //       predetermined, explicitly determined, and implicitly
1031       //       determined data-sharing attributes (2.15.1.1).
1032       if (Symbol * found{currScope().FindSymbol(name.source)}) {
1033         if (symbol != found) {
1034           name.symbol = found; // adjust the symbol within region
1035         } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
1036           context_.Say(name.source,
1037               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
1038               "a data-sharing attribute clause"_err_en_US,
1039               symbol->name());
1040         }
1041       }
1042     }
1043   } // within OpenMP construct
1044 }
1045 
ResolveName(const parser::Name * name)1046 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) {
1047   if (auto *resolvedSymbol{
1048           name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
1049     name->symbol = resolvedSymbol;
1050     return resolvedSymbol;
1051   } else {
1052     return nullptr;
1053   }
1054 }
1055 
ResolveOmpName(const parser::Name & name,Symbol::Flag ompFlag)1056 void OmpAttributeVisitor::ResolveOmpName(
1057     const parser::Name &name, Symbol::Flag ompFlag) {
1058   if (ResolveName(&name)) {
1059     if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) {
1060       if (dataSharingAttributeFlags.test(ompFlag)) {
1061         AddToContextObjectWithDSA(*resolvedSymbol, ompFlag);
1062       }
1063     }
1064   }
1065 }
1066 
ResolveOmpNameList(const std::list<parser::Name> & nameList,Symbol::Flag ompFlag)1067 void OmpAttributeVisitor::ResolveOmpNameList(
1068     const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) {
1069   for (const auto &name : nameList) {
1070     ResolveOmpName(name, ompFlag);
1071   }
1072 }
1073 
ResolveOmpCommonBlockName(const parser::Name * name)1074 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
1075     const parser::Name *name) {
1076   if (auto *prev{name
1077               ? GetContext().scope.parent().FindCommonBlock(name->source)
1078               : nullptr}) {
1079     name->symbol = prev;
1080     return prev;
1081   }
1082   // Check if the Common Block is declared in the current scope
1083   if (auto *commonBlockSymbol{
1084           name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
1085     name->symbol = commonBlockSymbol;
1086     return commonBlockSymbol;
1087   }
1088   return nullptr;
1089 }
1090 
ResolveOmpObjectList(const parser::OmpObjectList & ompObjectList,Symbol::Flag ompFlag)1091 void OmpAttributeVisitor::ResolveOmpObjectList(
1092     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
1093   for (const auto &ompObject : ompObjectList.v) {
1094     ResolveOmpObject(ompObject, ompFlag);
1095   }
1096 }
1097 
ResolveOmpObject(const parser::OmpObject & ompObject,Symbol::Flag ompFlag)1098 void OmpAttributeVisitor::ResolveOmpObject(
1099     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
1100   std::visit(
1101       common::visitors{
1102           [&](const parser::Designator &designator) {
1103             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
1104               if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
1105                 if (dataCopyingAttributeFlags.test(ompFlag)) {
1106                   CheckDataCopyingClause(*name, *symbol, ompFlag);
1107                 } else {
1108                   AddToContextObjectWithDSA(*symbol, ompFlag);
1109                   if (dataSharingAttributeFlags.test(ompFlag)) {
1110                     CheckMultipleAppearances(*name, *symbol, ompFlag);
1111                   }
1112                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
1113                     CheckObjectInNamelist(*name, *symbol, ompFlag);
1114                   }
1115 
1116                   if (ompFlag == Symbol::Flag::OmpAllocate) {
1117                     AddAllocateName(name);
1118                   }
1119                 }
1120               }
1121             } else {
1122               // Array sections to be changed to substrings as needed
1123               if (AnalyzeExpr(context_, designator)) {
1124                 if (std::holds_alternative<parser::Substring>(designator.u)) {
1125                   context_.Say(designator.source,
1126                       "Substrings are not allowed on OpenMP "
1127                       "directives or clauses"_err_en_US);
1128                 }
1129               }
1130               // other checks, more TBD
1131             }
1132           },
1133           [&](const parser::Name &name) { // common block
1134             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
1135               if (!dataCopyingAttributeFlags.test(ompFlag)) {
1136                 CheckMultipleAppearances(
1137                     name, *symbol, Symbol::Flag::OmpCommonBlock);
1138               }
1139               // 2.15.3 When a named common block appears in a list, it has the
1140               // same meaning as if every explicit member of the common block
1141               // appeared in the list
1142               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
1143                 if (auto *resolvedObject{
1144                         ResolveOmp(*object, ompFlag, currScope())}) {
1145                   if (dataCopyingAttributeFlags.test(ompFlag)) {
1146                     CheckDataCopyingClause(name, *resolvedObject, ompFlag);
1147                   } else {
1148                     AddToContextObjectWithDSA(*resolvedObject, ompFlag);
1149                   }
1150                 }
1151               }
1152             } else {
1153               context_.Say(name.source, // 2.15.3
1154                   "COMMON block must be declared in the same scoping unit "
1155                   "in which the OpenMP directive or clause appears"_err_en_US);
1156             }
1157           },
1158       },
1159       ompObject.u);
1160 }
1161 
ResolveOmp(const parser::Name & name,Symbol::Flag ompFlag,Scope & scope)1162 Symbol *OmpAttributeVisitor::ResolveOmp(
1163     const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {
1164   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1165     return DeclarePrivateAccessEntity(name, ompFlag, scope);
1166   } else {
1167     return DeclareOrMarkOtherAccessEntity(name, ompFlag);
1168   }
1169 }
1170 
ResolveOmp(Symbol & symbol,Symbol::Flag ompFlag,Scope & scope)1171 Symbol *OmpAttributeVisitor::ResolveOmp(
1172     Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {
1173   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1174     return DeclarePrivateAccessEntity(symbol, ompFlag, scope);
1175   } else {
1176     return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
1177   }
1178 }
1179 
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag ompFlag)1180 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1181     const parser::Name &name, Symbol::Flag ompFlag) {
1182   Symbol *prev{currScope().FindSymbol(name.source)};
1183   if (!name.symbol || !prev) {
1184     return nullptr;
1185   } else if (prev != name.symbol) {
1186     name.symbol = prev;
1187   }
1188   return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
1189 }
1190 
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag ompFlag)1191 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1192     Symbol &object, Symbol::Flag ompFlag) {
1193   if (ompFlagsRequireMark.test(ompFlag)) {
1194     object.set(ompFlag);
1195   }
1196   return &object;
1197 }
1198 
WithMultipleAppearancesOmpException(const Symbol & symbol,Symbol::Flag flag)1199 static bool WithMultipleAppearancesOmpException(
1200     const Symbol &symbol, Symbol::Flag flag) {
1201   return (flag == Symbol::Flag::OmpFirstPrivate &&
1202              symbol.test(Symbol::Flag::OmpLastPrivate)) ||
1203       (flag == Symbol::Flag::OmpLastPrivate &&
1204           symbol.test(Symbol::Flag::OmpFirstPrivate));
1205 }
1206 
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1207 void OmpAttributeVisitor::CheckMultipleAppearances(
1208     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1209   const auto *target{&symbol};
1210   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1211     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
1212       target = &details->symbol();
1213     }
1214   }
1215   if (HasDataSharingAttributeObject(*target) &&
1216       !WithMultipleAppearancesOmpException(symbol, ompFlag)) {
1217     context_.Say(name.source,
1218         "'%s' appears in more than one data-sharing clause "
1219         "on the same OpenMP directive"_err_en_US,
1220         name.ToString());
1221   } else {
1222     AddDataSharingAttributeObject(*target);
1223     if (privateDataSharingAttributeFlags.test(ompFlag)) {
1224       AddPrivateDataSharingAttributeObjects(*target);
1225     }
1226   }
1227 }
1228 
ResolveAccParts(SemanticsContext & context,const parser::ProgramUnit & node)1229 void ResolveAccParts(
1230     SemanticsContext &context, const parser::ProgramUnit &node) {
1231   if (context.IsEnabled(common::LanguageFeature::OpenACC)) {
1232     AccAttributeVisitor{context}.Walk(node);
1233   }
1234 }
1235 
ResolveOmpParts(SemanticsContext & context,const parser::ProgramUnit & node)1236 void ResolveOmpParts(
1237     SemanticsContext &context, const parser::ProgramUnit &node) {
1238   if (context.IsEnabled(common::LanguageFeature::OpenMP)) {
1239     OmpAttributeVisitor{context}.Walk(node);
1240     if (!context.AnyFatalError()) {
1241       // The data-sharing attribute of the loop iteration variable for a
1242       // sequential loop (2.15.1.1) can only be determined when visiting
1243       // the corresponding DoConstruct, a second walk is to adjust the
1244       // symbols for all the data-refs of that loop iteration variable
1245       // prior to the DoConstruct.
1246       OmpAttributeVisitor{context}.Walk(node);
1247     }
1248   }
1249 }
1250 
CheckDataCopyingClause(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1251 void OmpAttributeVisitor::CheckDataCopyingClause(
1252     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1253   const auto *checkSymbol{&symbol};
1254   if (ompFlag == Symbol::Flag::OmpCopyIn) {
1255     if (const auto *details{symbol.detailsIf<HostAssocDetails>()})
1256       checkSymbol = &details->symbol();
1257 
1258     // List of items/objects that can appear in a 'copyin' clause must be
1259     // 'threadprivate'
1260     if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate))
1261       context_.Say(name.source,
1262           "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
1263           checkSymbol->name());
1264   }
1265 }
1266 
CheckObjectInNamelist(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1267 void OmpAttributeVisitor::CheckObjectInNamelist(
1268     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1269   if (symbol.GetUltimate().test(Symbol::Flag::InNamelist)) {
1270     llvm::StringRef clauseName{"PRIVATE"};
1271     if (ompFlag == Symbol::Flag::OmpFirstPrivate)
1272       clauseName = "FIRSTPRIVATE";
1273     else if (ompFlag == Symbol::Flag::OmpLastPrivate)
1274       clauseName = "LASTPRIVATE";
1275     context_.Say(name.source,
1276         "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
1277         name.ToString(), clauseName.str());
1278   }
1279 }
1280 
1281 } // namespace Fortran::semantics
1282