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