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