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