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