flang/lib/Semantics/resolve-directives.cpp

   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/tools.h"
  17 #include "flang/Evaluate/type.h"
  18 #include "flang/Parser/parse-tree-visitor.h"
  19 #include "flang/Parser/parse-tree.h"
  20 #include "flang/Parser/tools.h"
  21 #include "flang/Semantics/expression.h"
  22 #include "flang/Semantics/symbol.h"
  23 #include "flang/Semantics/tools.h"
  24 #include <list>
  25 #include <map>
  26 #include <sstream>
  27
  28 template <typename T>
  29 static Fortran::semantics::Scope *GetScope(
  30     Fortran::semantics::SemanticsContext &context, const T &x) {
  31   std::optional<Fortran::parser::CharBlock> source{GetLastSource(x)};
  32   return source ? &context.FindScope(*source) : nullptr;
  33 }
  34
  35 namespace Fortran::semantics {
  36
  37 template <typename T> class DirectiveAttributeVisitor {
  38 public:
  39   explicit DirectiveAttributeVisitor(SemanticsContext &context)
  40       : context_{context} {}
  41
  42   template <typename A> bool Pre(const A &) { return true; }
  43   template <typename A> void Post(const A &) {}
  44
  45 protected:
  46   struct DirContext {
  47     DirContext(const parser::CharBlock &source, T d, Scope &s)
  48         : directiveSource{source}, directive{d}, scope{s} {}
  49     parser::CharBlock directiveSource;
  50     T directive;
  51     Scope &scope;
  52     Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC
  53     std::map<const Symbol *, Symbol::Flag> objectWithDSA;
  54     bool withinConstruct{false};
  55     std::int64_t associatedLoopLevel{0};
  56   };
  57
  58   DirContext &GetContext() {
  59     CHECK(!dirContext_.empty());
  60     return dirContext_.back();
  61   }
  62   std::optional<DirContext> GetContextIf() {
  63     return dirContext_.empty()
  64         ? std::nullopt
  65         : std::make_optional<DirContext>(dirContext_.back());
  66   }
  67   void PushContext(const parser::CharBlock &source, T dir, Scope &scope) {
  68     dirContext_.emplace_back(source, dir, scope);
  69   }
  70   void PushContext(const parser::CharBlock &source, T dir) {
  71     dirContext_.emplace_back(source, dir, context_.FindScope(source));
  72   }
  73   void PopContext() { dirContext_.pop_back(); }
  74   void SetContextDirectiveSource(parser::CharBlock &dir) {
  75     GetContext().directiveSource = dir;
  76   }
  77   Scope &currScope() { return GetContext().scope; }
  78   void SetContextDefaultDSA(Symbol::Flag flag) {
  79     GetContext().defaultDSA = flag;
  80   }
  81   void AddToContextObjectWithDSA(
  82       const Symbol &symbol, Symbol::Flag flag, DirContext &context) {
  83     context.objectWithDSA.emplace(&symbol, flag);
  84   }
  85   void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
  86     AddToContextObjectWithDSA(symbol, flag, GetContext());
  87   }
  88   bool IsObjectWithDSA(const Symbol &symbol) {
  89     auto it{GetContext().objectWithDSA.find(&symbol)};
  90     return it != GetContext().objectWithDSA.end();
  91   }
  92   void SetContextAssociatedLoopLevel(std::int64_t level) {
  93     GetContext().associatedLoopLevel = level;
  94   }
  95   Symbol &MakeAssocSymbol(
  96       const SourceName &name, const Symbol &prev, Scope &scope) {
  97     const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
  98     return *pair.first->second;
  99   }
 100   Symbol &MakeAssocSymbol(const SourceName &name, const Symbol &prev) {
 101     return MakeAssocSymbol(name, prev, currScope());
 102   }
 103   void AddDataSharingAttributeObject(SymbolRef object) {
 104     dataSharingAttributeObjects_.insert(object);
 105   }
 106   void ClearDataSharingAttributeObjects() {
 107     dataSharingAttributeObjects_.clear();
 108   }
 109   bool HasDataSharingAttributeObject(const Symbol &);
 110   const parser::Name *GetLoopIndex(const parser::DoConstruct &);
 111   const parser::DoConstruct *GetDoConstructIf(
 112       const parser::ExecutionPartConstruct &);
 113   Symbol *DeclareNewPrivateAccessEntity(const Symbol &, Symbol::Flag, Scope &);
 114   Symbol *DeclarePrivateAccessEntity(
 115       const parser::Name &, Symbol::Flag, Scope &);
 116   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &);
 117   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
 118
 119   UnorderedSymbolSet dataSharingAttributeObjects_; // on one directive
 120   SemanticsContext &context_;
 121   std::vector<DirContext> dirContext_; // used as a stack
 122 };
 123
 124 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
 125 public:
 126   explicit AccAttributeVisitor(SemanticsContext &context, Scope *topScope)
 127       : DirectiveAttributeVisitor(context), topScope_(topScope) {}
 128
 129   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
 130   template <typename A> bool Pre(const A &) { return true; }
 131   template <typename A> void Post(const A &) {}
 132
 133   bool Pre(const parser::OpenACCBlockConstruct &);
 134   void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
 135   bool Pre(const parser::OpenACCCombinedConstruct &);
 136   void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
 137
 138   bool Pre(const parser::OpenACCDeclarativeConstruct &);
 139   void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); }
 140
 141   void Post(const parser::AccDeclarativeDirective &) {
 142     GetContext().withinConstruct = true;
 143   }
 144
 145   bool Pre(const parser::OpenACCRoutineConstruct &);
 146   bool Pre(const parser::AccBindClause &);
 147   void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);
 148
 149   void Post(const parser::AccBeginBlockDirective &) {
 150     GetContext().withinConstruct = true;
 151   }
 152
 153   bool Pre(const parser::OpenACCLoopConstruct &);
 154   void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
 155   void Post(const parser::AccLoopDirective &) {
 156     GetContext().withinConstruct = true;
 157   }
 158
 159   bool Pre(const parser::OpenACCStandaloneConstruct &);
 160   void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
 161   void Post(const parser::AccStandaloneDirective &) {
 162     GetContext().withinConstruct = true;
 163   }
 164
 165   bool Pre(const parser::OpenACCCacheConstruct &);
 166   void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
 167
 168   void Post(const parser::AccDefaultClause &);
 169
 170   bool Pre(const parser::AccClause::Attach &);
 171   bool Pre(const parser::AccClause::Detach &);
 172
 173   bool Pre(const parser::AccClause::Copy &x) {
 174     ResolveAccObjectList(x.v, Symbol::Flag::AccCopy);
 175     return false;
 176   }
 177
 178   bool Pre(const parser::AccClause::Create &x) {
 179     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
 180     ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);
 181     return false;
 182   }
 183
 184   bool Pre(const parser::AccClause::Copyin &x) {
 185     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
 186     const auto &modifier{
 187         std::get<std::optional<parser::AccDataModifier>>(x.v.t)};
 188     if (modifier &&
 189         (*modifier).v == parser::AccDataModifier::Modifier::ReadOnly) {
 190       ResolveAccObjectList(objectList, Symbol::Flag::AccCopyInReadOnly);
 191     } else {
 192       ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);
 193     }
 194     return false;
 195   }
 196
 197   bool Pre(const parser::AccClause::Copyout &x) {
 198     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
 199     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);
 200     return false;
 201   }
 202
 203   bool Pre(const parser::AccClause::Present &x) {
 204     ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);
 205     return false;
 206   }
 207   bool Pre(const parser::AccClause::Private &x) {
 208     ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);
 209     return false;
 210   }
 211   bool Pre(const parser::AccClause::Firstprivate &x) {
 212     ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);
 213     return false;
 214   }
 215
 216   bool Pre(const parser::AccClause::Device &x) {
 217     ResolveAccObjectList(x.v, Symbol::Flag::AccDevice);
 218     return false;
 219   }
 220
 221   bool Pre(const parser::AccClause::DeviceResident &x) {
 222     ResolveAccObjectList(x.v, Symbol::Flag::AccDeviceResident);
 223     return false;
 224   }
 225
 226   bool Pre(const parser::AccClause::Deviceptr &x) {
 227     ResolveAccObjectList(x.v, Symbol::Flag::AccDevicePtr);
 228     return false;
 229   }
 230
 231   bool Pre(const parser::AccClause::Link &x) {
 232     ResolveAccObjectList(x.v, Symbol::Flag::AccLink);
 233     return false;
 234   }
 235
 236   bool Pre(const parser::AccClause::Host &x) {
 237     ResolveAccObjectList(x.v, Symbol::Flag::AccHost);
 238     return false;
 239   }
 240
 241   bool Pre(const parser::AccClause::Self &x) {
 242     const std::optional<parser::AccSelfClause> &accSelfClause = x.v;
 243     if (accSelfClause &&
 244         std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {
 245       const auto &accObjectList =
 246           std::get<parser::AccObjectList>((*accSelfClause).u);
 247       ResolveAccObjectList(accObjectList, Symbol::Flag::AccSelf);
 248     }
 249     return false;
 250   }
 251
 252   void Post(const parser::Name &);
 253
 254 private:
 255   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
 256
 257   Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::AccShared,
 258       Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,
 259       Symbol::Flag::AccReduction};
 260
 261   Symbol::Flags dataMappingAttributeFlags{Symbol::Flag::AccCreate,
 262       Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyOut,
 263       Symbol::Flag::AccDelete, Symbol::Flag::AccPresent};
 264
 265   Symbol::Flags accDataMvtFlags{
 266       Symbol::Flag::AccDevice, Symbol::Flag::AccHost, Symbol::Flag::AccSelf};
 267
 268   Symbol::Flags accFlagsRequireMark{Symbol::Flag::AccCreate,
 269       Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyInReadOnly,
 270       Symbol::Flag::AccCopy, Symbol::Flag::AccCopyOut,
 271       Symbol::Flag::AccDevicePtr, Symbol::Flag::AccDeviceResident,
 272       Symbol::Flag::AccLink, Symbol::Flag::AccPresent};
 273
 274   void CheckAssociatedLoop(const parser::DoConstruct &);
 275   void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
 276   void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
 277   Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
 278   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
 279   Symbol *ResolveName(const parser::Name &, bool parentScope = false);
 280   Symbol *ResolveFctName(const parser::Name &);
 281   Symbol *ResolveAccCommonBlockName(const parser::Name *);
 282   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
 283   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
 284   void CheckMultipleAppearances(
 285       const parser::Name &, const Symbol &, Symbol::Flag);
 286   void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
 287   void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
 288   void AllowOnlyVariable(const parser::AccObject &object);
 289   void EnsureAllocatableOrPointer(
 290       const llvm::acc::Clause clause, const parser::AccObjectList &objectList);
 291   void AddRoutineInfoToSymbol(
 292       Symbol &, const parser::OpenACCRoutineConstruct &);
 293   Scope *topScope_;
 294 };
 295
 296 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
 297 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
 298 public:
 299   explicit OmpAttributeVisitor(SemanticsContext &context)
 300       : DirectiveAttributeVisitor(context) {}
 301
 302   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
 303   template <typename A> bool Pre(const A &) { return true; }
 304   template <typename A> void Post(const A &) {}
 305
 306   template <typename A> bool Pre(const parser::Statement<A> &statement) {
 307     currentStatementSource_ = statement.source;
 308     // Keep track of the labels in all the labelled statements
 309     if (statement.label) {
 310       auto label{statement.label.value()};
 311       // Get the context to check if the labelled statement is in an
 312       // enclosing OpenMP construct
 313       std::optional<DirContext> thisContext{GetContextIf()};
 314       targetLabels_.emplace(
 315           label, std::make_pair(currentStatementSource_, thisContext));
 316       // Check if a statement that causes a jump to the 'label'
 317       // has already been encountered
 318       auto range{sourceLabels_.equal_range(label)};
 319       for (auto it{range.first}; it != range.second; ++it) {
 320         // Check if both the statement with 'label' and the statement that
 321         // causes a jump to the 'label' are in the same scope
 322         CheckLabelContext(it->second.first, currentStatementSource_,
 323             it->second.second, thisContext);
 324       }
 325     }
 326     return true;
 327   }
 328
 329   bool Pre(const parser::InternalSubprogram &) {
 330     // Clear the labels being tracked in the previous scope
 331     ClearLabels();
 332     return true;
 333   }
 334
 335   bool Pre(const parser::ModuleSubprogram &) {
 336     // Clear the labels being tracked in the previous scope
 337     ClearLabels();
 338     return true;
 339   }
 340
 341   bool Pre(const parser::StmtFunctionStmt &x) {
 342     const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
 343     if (const auto *expr{GetExpr(context_, parsedExpr)}) {
 344       for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
 345         if (!IsStmtFunctionDummy(symbol)) {
 346           stmtFunctionExprSymbols_.insert(symbol.GetUltimate());
 347         }
 348       }
 349     }
 350     return true;
 351   }
 352
 353   bool Pre(const parser::OpenMPBlockConstruct &);
 354   void Post(const parser::OpenMPBlockConstruct &);
 355
 356   void Post(const parser::OmpBeginBlockDirective &) {
 357     GetContext().withinConstruct = true;
 358   }
 359
 360   bool Pre(const parser::OpenMPSimpleStandaloneConstruct &);
 361   void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); }
 362
 363   bool Pre(const parser::OpenMPLoopConstruct &);
 364   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
 365   void Post(const parser::OmpBeginLoopDirective &) {
 366     GetContext().withinConstruct = true;
 367   }
 368   bool Pre(const parser::DoConstruct &);
 369
 370   bool Pre(const parser::OpenMPSectionsConstruct &);
 371   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
 372
 373   bool Pre(const parser::OpenMPCriticalConstruct &critical);
 374   void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); }
 375
 376   bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
 377     PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd);
 378     const auto &name{std::get<std::optional<parser::Name>>(x.t)};
 379     if (name) {
 380       ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd);
 381     }
 382     return true;
 383   }
 384   void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }
 385
 386   bool Pre(const parser::OpenMPDepobjConstruct &x) {
 387     PushContext(x.source, llvm::omp::Directive::OMPD_depobj);
 388     auto &object{std::get<parser::OmpObject>(x.t)};
 389     ResolveOmpObject(object, Symbol::Flag::OmpDependObject);
 390     return true;
 391   }
 392   void Post(const parser::OpenMPDepobjConstruct &) { PopContext(); }
 393
 394   bool Pre(const parser::OpenMPRequiresConstruct &x) {
 395     using Flags = WithOmpDeclarative::RequiresFlags;
 396     using Requires = WithOmpDeclarative::RequiresFlag;
 397     PushContext(x.source, llvm::omp::Directive::OMPD_requires);
 398
 399     // Gather information from the clauses.
 400     Flags flags;
 401     std::optional<common::OmpAtomicDefaultMemOrderType> memOrder;
 402     for (const auto &clause : std::get<parser::OmpClauseList>(x.t).v) {
 403       flags |= common::visit(
 404           common::visitors{
 405               [&memOrder](
 406                   const parser::OmpClause::AtomicDefaultMemOrder &atomic) {
 407                 memOrder = atomic.v.v;
 408                 return Flags{};
 409               },
 410               [](const parser::OmpClause::ReverseOffload &) {
 411                 return Flags{Requires::ReverseOffload};
 412               },
 413               [](const parser::OmpClause::UnifiedAddress &) {
 414                 return Flags{Requires::UnifiedAddress};
 415               },
 416               [](const parser::OmpClause::UnifiedSharedMemory &) {
 417                 return Flags{Requires::UnifiedSharedMemory};
 418               },
 419               [](const parser::OmpClause::DynamicAllocators &) {
 420                 return Flags{Requires::DynamicAllocators};
 421               },
 422               [](const auto &) { return Flags{}; }},
 423           clause.u);
 424     }
 425     // Merge clauses into parents' symbols details.
 426     AddOmpRequiresToScope(currScope(), flags, memOrder);
 427     return true;
 428   }
 429   void Post(const parser::OpenMPRequiresConstruct &) { PopContext(); }
 430
 431   bool Pre(const parser::OpenMPDeclareTargetConstruct &);
 432   void Post(const parser::OpenMPDeclareTargetConstruct &) { PopContext(); }
 433
 434   bool Pre(const parser::OpenMPDeclareMapperConstruct &);
 435   void Post(const parser::OpenMPDeclareMapperConstruct &) { PopContext(); }
 436
 437   bool Pre(const parser::OpenMPThreadprivate &);
 438   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
 439
 440   bool Pre(const parser::OpenMPDeclarativeAllocate &);
 441   void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); }
 442
 443   bool Pre(const parser::OpenMPExecutableAllocate &);
 444   void Post(const parser::OpenMPExecutableAllocate &);
 445
 446   bool Pre(const parser::OpenMPAllocatorsConstruct &);
 447   void Post(const parser::OpenMPAllocatorsConstruct &);
 448
 449   void Post(const parser::OmpObjectList &x) {
 450     // The objects from OMP clauses should have already been resolved,
 451     // except common blocks (the ResolveNamesVisitor does not visit
 452     // parser::Name, those are dealt with as members of other structures).
 453     // Iterate over elements of x, and resolve any common blocks that
 454     // are still unresolved.
 455     for (const parser::OmpObject &obj : x.v) {
 456       auto *name{std::get_if<parser::Name>(&obj.u)};
 457       if (name && !name->symbol) {
 458         Resolve(*name, currScope().MakeCommonBlock(name->source));
 459       }
 460     }
 461   }
 462
 463   // 2.15.3 Data-Sharing Attribute Clauses
 464   bool Pre(const parser::OmpClause::Inclusive &x) {
 465     ResolveOmpObjectList(x.v, Symbol::Flag::OmpInclusiveScan);
 466     return false;
 467   }
 468   bool Pre(const parser::OmpClause::Exclusive &x) {
 469     ResolveOmpObjectList(x.v, Symbol::Flag::OmpExclusiveScan);
 470     return false;
 471   }
 472   void Post(const parser::OmpDefaultClause &);
 473   bool Pre(const parser::OmpClause::Shared &x) {
 474     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
 475     return false;
 476   }
 477   bool Pre(const parser::OmpClause::Private &x) {
 478     ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
 479     return false;
 480   }
 481   bool Pre(const parser::OmpAllocateClause &x) {
 482     const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
 483     ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate);
 484     return false;
 485   }
 486   bool Pre(const parser::OmpClause::Firstprivate &x) {
 487     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
 488     return false;
 489   }
 490   bool Pre(const parser::OmpClause::Lastprivate &x) {
 491     const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
 492     ResolveOmpObjectList(objList, Symbol::Flag::OmpLastPrivate);
 493     return false;
 494   }
 495   bool Pre(const parser::OmpClause::Copyin &x) {
 496     ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);
 497     return false;
 498   }
 499   bool Pre(const parser::OmpClause::Copyprivate &x) {
 500     ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyPrivate);
 501     return false;
 502   }
 503   bool Pre(const parser::OmpLinearClause &x) {
 504     common::visit(common::visitors{
 505                       [&](const parser::OmpLinearClause::WithoutModifier
 506                               &linearWithoutModifier) {
 507                         ResolveOmpNameList(linearWithoutModifier.names,
 508                             Symbol::Flag::OmpLinear);
 509                       },
 510                       [&](const parser::OmpLinearClause::WithModifier
 511                               &linearWithModifier) {
 512                         ResolveOmpNameList(
 513                             linearWithModifier.names, Symbol::Flag::OmpLinear);
 514                       },
 515                   },
 516         x.u);
 517     return false;
 518   }
 519
 520   bool Pre(const parser::OmpClause::Reduction &x) {
 521     const parser::OmpReductionOperator &opr{
 522         std::get<parser::OmpReductionOperator>(x.v.t)};
 523     auto createDummyProcSymbol = [&](const parser::Name *name) {
 524       // If name resolution failed, create a dummy symbol
 525       const auto namePair{
 526           currScope().try_emplace(name->source, Attrs{}, ProcEntityDetails{})};
 527       auto &newSymbol{*namePair.first->second};
 528       if (context_.intrinsics().IsIntrinsic(name->ToString())) {
 529         newSymbol.attrs().set(Attr::INTRINSIC);
 530       }
 531       name->symbol = &newSymbol;
 532     };
 533     if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {
 534       if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
 535         if (!name->symbol) {
 536           if (!ResolveName(name)) {
 537             createDummyProcSymbol(name);
 538           }
 539         }
 540       }
 541       if (const auto *procRef{
 542               parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {
 543         if (!procRef->v.thing.component.symbol) {
 544           if (!ResolveName(&procRef->v.thing.component)) {
 545             createDummyProcSymbol(&procRef->v.thing.component);
 546           }
 547         }
 548       }
 549     }
 550     const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
 551     ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction);
 552     using ReductionModifier = parser::OmpReductionClause::ReductionModifier;
 553     const auto &maybeModifier{
 554         std::get<std::optional<ReductionModifier>>(x.v.t)};
 555     if (maybeModifier && *maybeModifier == ReductionModifier::Inscan) {
 556       ResolveOmpObjectList(objList, Symbol::Flag::OmpInScanReduction);
 557     }
 558     return false;
 559   }
 560
 561   bool Pre(const parser::OmpAlignedClause &x) {
 562     const auto &alignedNameList{std::get<parser::OmpObjectList>(x.t)};
 563     ResolveOmpObjectList(alignedNameList, Symbol::Flag::OmpAligned);
 564     return false;
 565   }
 566
 567   bool Pre(const parser::OmpClause::Nontemporal &x) {
 568     const auto &nontemporalNameList{x.v};
 569     ResolveOmpNameList(nontemporalNameList, Symbol::Flag::OmpNontemporal);
 570     return false;
 571   }
 572
 573   void Post(const parser::OmpIteration &x) {
 574     if (const auto &name{std::get<parser::Name>(x.t)}; !name.symbol) {
 575       auto *symbol{currScope().FindSymbol(name.source)};
 576       if (!symbol) {
 577         // OmpIteration must use an existing object. If there isn't one,
 578         // create a fake one and flag an error later.
 579         symbol = &currScope().MakeSymbol(
 580             name.source, Attrs{}, EntityDetails(/*isDummy=*/true));
 581       }
 582       Resolve(name, symbol);
 583     }
 584   }
 585
 586   bool Pre(const parser::OmpClause::UseDevicePtr &x) {
 587     ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDevicePtr);
 588     return false;
 589   }
 590
 591   bool Pre(const parser::OmpClause::UseDeviceAddr &x) {
 592     ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDeviceAddr);
 593     return false;
 594   }
 595
 596   bool Pre(const parser::OmpClause::IsDevicePtr &x) {
 597     ResolveOmpObjectList(x.v, Symbol::Flag::OmpIsDevicePtr);
 598     return false;
 599   }
 600
 601   bool Pre(const parser::OmpClause::HasDeviceAddr &x) {
 602     ResolveOmpObjectList(x.v, Symbol::Flag::OmpHasDeviceAddr);
 603     return false;
 604   }
 605
 606   void Post(const parser::Name &);
 607
 608   // Keep track of labels in the statements that causes jumps to target labels
 609   void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); }
 610   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
 611     for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
 612       CheckSourceLabel(label);
 613     }
 614   }
 615   void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
 616     CheckSourceLabel(std::get<1>(arithmeticIfStmt.t));
 617     CheckSourceLabel(std::get<2>(arithmeticIfStmt.t));
 618     CheckSourceLabel(std::get<3>(arithmeticIfStmt.t));
 619   }
 620   void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
 621     for (auto &label : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
 622       CheckSourceLabel(label);
 623     }
 624   }
 625   void Post(const parser::AltReturnSpec &altReturnSpec) {
 626     CheckSourceLabel(altReturnSpec.v);
 627   }
 628   void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); }
 629   void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); }
 630   void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); }
 631
 632   void Post(const parser::OmpMapClause &x) {
 633     Symbol::Flag ompFlag = Symbol::Flag::OmpMapToFrom;
 634     // There is only one `type' allowed, but it's parsed as a list. Multiple
 635     // types are diagnosed in the semantic checks for OpenMP.
 636     if (const auto &mapType{
 637             std::get<std::optional<std::list<parser::OmpMapClause::Type>>>(
 638                 x.t)}) {
 639       switch (mapType->front()) {
 640       case parser::OmpMapClause::Type::To:
 641         ompFlag = Symbol::Flag::OmpMapTo;
 642         break;
 643       case parser::OmpMapClause::Type::From:
 644         ompFlag = Symbol::Flag::OmpMapFrom;
 645         break;
 646       case parser::OmpMapClause::Type::Tofrom:
 647         ompFlag = Symbol::Flag::OmpMapToFrom;
 648         break;
 649       case parser::OmpMapClause::Type::Alloc:
 650         ompFlag = Symbol::Flag::OmpMapAlloc;
 651         break;
 652       case parser::OmpMapClause::Type::Release:
 653         ompFlag = Symbol::Flag::OmpMapRelease;
 654         break;
 655       case parser::OmpMapClause::Type::Delete:
 656         ompFlag = Symbol::Flag::OmpMapDelete;
 657         break;
 658       }
 659     }
 660     const auto &ompObjList{std::get<parser::OmpObjectList>(x.t)};
 661     for (const auto &ompObj : ompObjList.v) {
 662       common::visit(
 663           common::visitors{
 664               [&](const parser::Designator &designator) {
 665                 if (const auto *name{
 666                         semantics::getDesignatorNameIfDataRef(designator)}) {
 667                   if (name->symbol) {
 668                     name->symbol->set(ompFlag);
 669                     AddToContextObjectWithDSA(*name->symbol, ompFlag);
 670                   }
 671                   if (name->symbol &&
 672                       semantics::IsAssumedSizeArray(*name->symbol)) {
 673                     context_.Say(designator.source,
 674                         "Assumed-size whole arrays may not appear on the %s "
 675                         "clause"_err_en_US,
 676                         "MAP");
 677                   }
 678                 }
 679               },
 680               [&](const auto &name) {},
 681           },
 682           ompObj.u);
 683
 684       ResolveOmpObject(ompObj, ompFlag);
 685     }
 686   }
 687
 688   const parser::OmpClause *associatedClause{nullptr};
 689   void SetAssociatedClause(const parser::OmpClause &c) {
 690     associatedClause = &c;
 691   }
 692   const parser::OmpClause *GetAssociatedClause() { return associatedClause; }
 693
 694 private:
 695   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
 696
 697   Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::OmpShared,
 698       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
 699       Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpReduction,
 700       Symbol::Flag::OmpLinear};
 701
 702   Symbol::Flags privateDataSharingAttributeFlags{Symbol::Flag::OmpPrivate,
 703       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate};
 704
 705   Symbol::Flags ompFlagsRequireNewSymbol{Symbol::Flag::OmpPrivate,
 706       Symbol::Flag::OmpLinear, Symbol::Flag::OmpFirstPrivate,
 707       Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpReduction,
 708       Symbol::Flag::OmpCriticalLock, Symbol::Flag::OmpCopyIn,
 709       Symbol::Flag::OmpUseDevicePtr, Symbol::Flag::OmpUseDeviceAddr,
 710       Symbol::Flag::OmpIsDevicePtr, Symbol::Flag::OmpHasDeviceAddr};
 711
 712   Symbol::Flags ompFlagsRequireMark{Symbol::Flag::OmpThreadprivate,
 713       Symbol::Flag::OmpDeclareTarget, Symbol::Flag::OmpExclusiveScan,
 714       Symbol::Flag::OmpInclusiveScan, Symbol::Flag::OmpInScanReduction};
 715
 716   Symbol::Flags dataCopyingAttributeFlags{
 717       Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate};
 718
 719   std::vector<const parser::Name *> allocateNames_; // on one directive
 720   UnorderedSymbolSet privateDataSharingAttributeObjects_; // on one directive
 721   UnorderedSymbolSet stmtFunctionExprSymbols_;
 722   std::multimap<const parser::Label,
 723       std::pair<parser::CharBlock, std::optional<DirContext>>>
 724       sourceLabels_;
 725   std::map<const parser::Label,
 726       std::pair<parser::CharBlock, std::optional<DirContext>>>
 727       targetLabels_;
 728   parser::CharBlock currentStatementSource_;
 729
 730   void AddAllocateName(const parser::Name *&object) {
 731     allocateNames_.push_back(object);
 732   }
 733   void ClearAllocateNames() { allocateNames_.clear(); }
 734
 735   void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
 736     privateDataSharingAttributeObjects_.insert(object);
 737   }
 738   void ClearPrivateDataSharingAttributeObjects() {
 739     privateDataSharingAttributeObjects_.clear();
 740   }
 741
 742   // Predetermined DSA rules
 743   void PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
 744       const parser::OpenMPLoopConstruct &);
 745   void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
 746
 747   bool IsNestedInDirective(llvm::omp::Directive directive);
 748   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
 749   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
 750   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
 751   Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
 752   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
 753   void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
 754   void ResolveOmpName(const parser::Name &, Symbol::Flag);
 755   Symbol *ResolveName(const parser::Name *);
 756   Symbol *ResolveOmpObjectScope(const parser::Name *);
 757   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
 758   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
 759   void CheckMultipleAppearances(
 760       const parser::Name &, const Symbol &, Symbol::Flag);
 761
 762   void CheckDataCopyingClause(
 763       const parser::Name &, const Symbol &, Symbol::Flag);
 764   void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);
 765   void CheckObjectIsPrivatizable(
 766       const parser::Name &, const Symbol &, Symbol::Flag);
 767   void CheckSourceLabel(const parser::Label &);
 768   void CheckLabelContext(const parser::CharBlock, const parser::CharBlock,
 769       std::optional<DirContext>, std::optional<DirContext>);
 770   void ClearLabels() {
 771     sourceLabels_.clear();
 772     targetLabels_.clear();
 773   };
 774   void CheckAllNamesInAllocateStmt(const parser::CharBlock &source,
 775       const parser::OmpObjectList &ompObjectList,
 776       const parser::AllocateStmt &allocate);
 777   void CheckNameInAllocateStmt(const parser::CharBlock &source,
 778       const parser::Name &ompObject, const parser::AllocateStmt &allocate);
 779
 780   std::int64_t ordCollapseLevel{0};
 781
 782   void AddOmpRequiresToScope(Scope &, WithOmpDeclarative::RequiresFlags,
 783       std::optional<common::OmpAtomicDefaultMemOrderType>);
 784   void IssueNonConformanceWarning(
 785       llvm::omp::Directive D, parser::CharBlock source);
 786
 787   void CreateImplicitSymbols(
 788       const Symbol *symbol, std::optional<Symbol::Flag> setFlag = std::nullopt);
 789 };
 790
 791 template <typename T>
 792 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
 793     const Symbol &object) {
 794   auto it{dataSharingAttributeObjects_.find(object)};
 795   return it != dataSharingAttributeObjects_.end();
 796 }
 797
 798 template <typename T>
 799 const parser::Name *DirectiveAttributeVisitor<T>::GetLoopIndex(
 800     const parser::DoConstruct &x) {
 801   using Bounds = parser::LoopControl::Bounds;
 802   if (x.GetLoopControl()) {
 803     if (const Bounds * b{std::get_if<Bounds>(&x.GetLoopControl()->u)}) {
 804       return &b->name.thing;
 805     } else {
 806       return nullptr;
 807     }
 808   } else {
 809     context_
 810         .Say(std::get<parser::Statement<parser::NonLabelDoStmt>>(x.t).source,
 811             "Loop control is not present in the DO LOOP"_err_en_US)
 812         .Attach(GetContext().directiveSource,
 813             "associated with the enclosing LOOP construct"_en_US);
 814     return nullptr;
 815   }
 816 }
 817
 818 template <typename T>
 819 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(
 820     const parser::ExecutionPartConstruct &x) {
 821   return parser::Unwrap<parser::DoConstruct>(x);
 822 }
 823
 824 template <typename T>
 825 Symbol *DirectiveAttributeVisitor<T>::DeclareNewPrivateAccessEntity(
 826     const Symbol &object, Symbol::Flag flag, Scope &scope) {
 827   assert(object.owner() != currScope());
 828   auto &symbol{MakeAssocSymbol(object.name(), object, scope)};
 829   symbol.set(flag);
 830   if (flag == Symbol::Flag::OmpCopyIn) {
 831     // The symbol in copyin clause must be threadprivate entity.
 832     symbol.set(Symbol::Flag::OmpThreadprivate);
 833   }
 834   return &symbol;
 835 }
 836
 837 template <typename T>
 838 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
 839     const parser::Name &name, Symbol::Flag flag, Scope &scope) {
 840   if (!name.symbol) {
 841     return nullptr; // not resolved by Name Resolution step, do nothing
 842   }
 843   name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope);
 844   return name.symbol;
 845 }
 846
 847 template <typename T>
 848 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
 849     Symbol &object, Symbol::Flag flag, Scope &scope) {
 850   if (object.owner() != currScope()) {
 851     return DeclareNewPrivateAccessEntity(object, flag, scope);
 852   } else {
 853     object.set(flag);
 854     return &object;
 855   }
 856 }
 857
 858 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
 859   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
 860   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
 861   switch (blockDir.v) {
 862   case llvm::acc::Directive::ACCD_data:
 863   case llvm::acc::Directive::ACCD_host_data:
 864   case llvm::acc::Directive::ACCD_kernels:
 865   case llvm::acc::Directive::ACCD_parallel:
 866   case llvm::acc::Directive::ACCD_serial:
 867     PushContext(blockDir.source, blockDir.v);
 868     break;
 869   default:
 870     break;
 871   }
 872   ClearDataSharingAttributeObjects();
 873   return true;
 874 }
 875
 876 bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) {
 877   if (const auto *declConstruct{
 878           std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) {
 879     const auto &declDir{
 880         std::get<parser::AccDeclarativeDirective>(declConstruct->t)};
 881     PushContext(declDir.source, llvm::acc::Directive::ACCD_declare);
 882   }
 883   ClearDataSharingAttributeObjects();
 884   return true;
 885 }
 886
 887 static const parser::AccObjectList &GetAccObjectList(
 888     const parser::AccClause &clause) {
 889   if (const auto *copyClause =
 890           std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {
 891     return copyClause->v;
 892   } else if (const auto *createClause =
 893                  std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {
 894     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
 895         createClause->v;
 896     const Fortran::parser::AccObjectList &accObjectList =
 897         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
 898     return accObjectList;
 899   } else if (const auto *copyinClause =
 900                  std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {
 901     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
 902         copyinClause->v;
 903     const Fortran::parser::AccObjectList &accObjectList =
 904         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
 905     return accObjectList;
 906   } else if (const auto *copyoutClause =
 907                  std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) {
 908     const Fortran::parser::AccObjectListWithModifier &listWithModifier =
 909         copyoutClause->v;
 910     const Fortran::parser::AccObjectList &accObjectList =
 911         std::get<Fortran::parser::AccObjectList>(listWithModifier.t);
 912     return accObjectList;
 913   } else if (const auto *presentClause =
 914                  std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) {
 915     return presentClause->v;
 916   } else if (const auto *deviceptrClause =
 917                  std::get_if<Fortran::parser::AccClause::Deviceptr>(
 918                      &clause.u)) {
 919     return deviceptrClause->v;
 920   } else if (const auto *deviceResidentClause =
 921                  std::get_if<Fortran::parser::AccClause::DeviceResident>(
 922                      &clause.u)) {
 923     return deviceResidentClause->v;
 924   } else if (const auto *linkClause =
 925                  std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {
 926     return linkClause->v;
 927   } else {
 928     llvm_unreachable("Clause without object list!");
 929   }
 930 }
 931
 932 void AccAttributeVisitor::Post(
 933     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
 934   const auto &clauseList = std::get<parser::AccClauseList>(x.t);
 935   for (const auto &clause : clauseList.v) {
 936     // Restriction - line 2414
 937     DoNotAllowAssumedSizedArray(GetAccObjectList(clause));
 938   }
 939 }
 940
 941 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
 942   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
 943   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
 944   const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
 945   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
 946     PushContext(loopDir.source, loopDir.v);
 947   }
 948   ClearDataSharingAttributeObjects();
 949   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
 950   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
 951   CheckAssociatedLoop(*outer);
 952   return true;
 953 }
 954
 955 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
 956   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
 957   switch (standaloneDir.v) {
 958   case llvm::acc::Directive::ACCD_enter_data:
 959   case llvm::acc::Directive::ACCD_exit_data:
 960   case llvm::acc::Directive::ACCD_init:
 961   case llvm::acc::Directive::ACCD_set:
 962   case llvm::acc::Directive::ACCD_shutdown:
 963   case llvm::acc::Directive::ACCD_update:
 964     PushContext(standaloneDir.source, standaloneDir.v);
 965     break;
 966   default:
 967     break;
 968   }
 969   ClearDataSharingAttributeObjects();
 970   return true;
 971 }
 972
 973 Symbol *AccAttributeVisitor::ResolveName(
 974     const parser::Name &name, bool parentScope) {
 975   Symbol *prev{currScope().FindSymbol(name.source)};
 976   // Check in parent scope if asked for.
 977   if (!prev && parentScope) {
 978     prev = currScope().parent().FindSymbol(name.source);
 979   }
 980   if (prev != name.symbol) {
 981     name.symbol = prev;
 982   }
 983   return prev;
 984 }
 985
 986 Symbol *AccAttributeVisitor::ResolveFctName(const parser::Name &name) {
 987   Symbol *prev{currScope().FindSymbol(name.source)};
 988   if (!prev || (prev && prev->IsFuncResult())) {
 989     prev = currScope().parent().FindSymbol(name.source);
 990     if (!prev) {
 991       prev = &context_.globalScope().MakeSymbol(
 992           name.source, Attrs{}, ProcEntityDetails{});
 993     }
 994   }
 995   if (prev != name.symbol) {
 996     name.symbol = prev;
 997   }
 998   return prev;
 999 }
1000
1001 template <typename T>
1002 common::IfNoLvalue<T, T> FoldExpr(
1003     evaluate::FoldingContext &foldingContext, T &&expr) {
1004   return evaluate::Fold(foldingContext, std::move(expr));
1005 }
1006
1007 template <typename T>
1008 MaybeExpr EvaluateExpr(
1009     Fortran::semantics::SemanticsContext &semanticsContext, const T &expr) {
1010   return FoldExpr(
1011       semanticsContext.foldingContext(), AnalyzeExpr(semanticsContext, expr));
1012 }
1013
1014 void AccAttributeVisitor::AddRoutineInfoToSymbol(
1015     Symbol &symbol, const parser::OpenACCRoutineConstruct &x) {
1016   if (symbol.has<SubprogramDetails>()) {
1017     Fortran::semantics::OpenACCRoutineInfo info;
1018     const auto &clauses = std::get<Fortran::parser::AccClauseList>(x.t);
1019     for (const Fortran::parser::AccClause &clause : clauses.v) {
1020       if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {
1021         if (info.deviceTypeInfos().empty()) {
1022           info.set_isSeq();
1023         } else {
1024           info.deviceTypeInfos().back().set_isSeq();
1025         }
1026       } else if (const auto *gangClause =
1027                      std::get_if<Fortran::parser::AccClause::Gang>(&clause.u)) {
1028         if (info.deviceTypeInfos().empty()) {
1029           info.set_isGang();
1030         } else {
1031           info.deviceTypeInfos().back().set_isGang();
1032         }
1033         if (gangClause->v) {
1034           const Fortran::parser::AccGangArgList &x = *gangClause->v;
1035           for (const Fortran::parser::AccGangArg &gangArg : x.v) {
1036             if (const auto *dim =
1037                     std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) {
1038               if (const auto v{EvaluateInt64(context_, dim->v)}) {
1039                 if (info.deviceTypeInfos().empty()) {
1040                   info.set_gangDim(*v);
1041                 } else {
1042                   info.deviceTypeInfos().back().set_gangDim(*v);
1043                 }
1044               }
1045             }
1046           }
1047         }
1048       } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {
1049         if (info.deviceTypeInfos().empty()) {
1050           info.set_isVector();
1051         } else {
1052           info.deviceTypeInfos().back().set_isVector();
1053         }
1054       } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {
1055         if (info.deviceTypeInfos().empty()) {
1056           info.set_isWorker();
1057         } else {
1058           info.deviceTypeInfos().back().set_isWorker();
1059         }
1060       } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {
1061         info.set_isNohost();
1062       } else if (const auto *bindClause =
1063                      std::get_if<Fortran::parser::AccClause::Bind>(&clause.u)) {
1064         if (const auto *name =
1065                 std::get_if<Fortran::parser::Name>(&bindClause->v.u)) {
1066           if (Symbol *sym = ResolveFctName(*name)) {
1067             if (info.deviceTypeInfos().empty()) {
1068               info.set_bindName(sym->name().ToString());
1069             } else {
1070               info.deviceTypeInfos().back().set_bindName(
1071                   sym->name().ToString());
1072             }
1073           } else {
1074             context_.Say((*name).source,
1075                 "No function or subroutine declared for '%s'"_err_en_US,
1076                 (*name).source);
1077           }
1078         } else if (const auto charExpr =
1079                        std::get_if<Fortran::parser::ScalarDefaultCharExpr>(
1080                            &bindClause->v.u)) {
1081           auto *charConst =
1082               Fortran::parser::Unwrap<Fortran::parser::CharLiteralConstant>(
1083                   *charExpr);
1084           std::string str{std::get<std::string>(charConst->t)};
1085           std::stringstream bindName;
1086           bindName << "\"" << str << "\"";
1087           if (info.deviceTypeInfos().empty()) {
1088             info.set_bindName(bindName.str());
1089           } else {
1090             info.deviceTypeInfos().back().set_bindName(bindName.str());
1091           }
1092         }
1093       } else if (const auto *dType =
1094                      std::get_if<Fortran::parser::AccClause::DeviceType>(
1095                          &clause.u)) {
1096         const parser::AccDeviceTypeExprList &deviceTypeExprList = dType->v;
1097         OpenACCRoutineDeviceTypeInfo dtypeInfo;
1098         dtypeInfo.set_dType(deviceTypeExprList.v.front().v);
1099         info.add_deviceTypeInfo(dtypeInfo);
1100       }
1101     }
1102     symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);
1103   }
1104 }
1105
1106 bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) {
1107   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
1108   if (topScope_) {
1109     PushContext(
1110         verbatim.source, llvm::acc::Directive::ACCD_routine, *topScope_);
1111   } else {
1112     PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine);
1113   }
1114   const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
1115   if (optName) {
1116     if (Symbol *sym = ResolveFctName(*optName)) {
1117       Symbol &ultimate{sym->GetUltimate()};
1118       AddRoutineInfoToSymbol(ultimate, x);
1119     } else {
1120       context_.Say((*optName).source,
1121           "No function or subroutine declared for '%s'"_err_en_US,
1122           (*optName).source);
1123     }
1124   } else {
1125     if (currScope().symbol()) {
1126       AddRoutineInfoToSymbol(*currScope().symbol(), x);
1127     }
1128   }
1129   return true;
1130 }
1131
1132 bool AccAttributeVisitor::Pre(const parser::AccBindClause &x) {
1133   if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
1134     if (!ResolveFctName(*name)) {
1135       context_.Say(name->source,
1136           "No function or subroutine declared for '%s'"_err_en_US,
1137           name->source);
1138     }
1139   }
1140   return true;
1141 }
1142
1143 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
1144   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
1145   const auto &combinedDir{
1146       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
1147   switch (combinedDir.v) {
1148   case llvm::acc::Directive::ACCD_kernels_loop:
1149   case llvm::acc::Directive::ACCD_parallel_loop:
1150   case llvm::acc::Directive::ACCD_serial_loop:
1151     PushContext(combinedDir.source, combinedDir.v);
1152     break;
1153   default:
1154     break;
1155   }
1156   const auto &clauseList{std::get<parser::AccClauseList>(beginBlockDir.t)};
1157   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
1158   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
1159   CheckAssociatedLoop(*outer);
1160   ClearDataSharingAttributeObjects();
1161   return true;
1162 }
1163
1164 static bool IsLastNameArray(const parser::Designator &designator) {
1165   const auto &name{GetLastName(designator)};
1166   const evaluate::DataRef dataRef{*(name.symbol)};
1167   return common::visit(
1168       common::visitors{
1169           [](const evaluate::SymbolRef &ref) {
1170             return ref->Rank() > 0 ||
1171                 ref->GetType()->category() == DeclTypeSpec::Numeric;
1172           },
1173           [](const evaluate::ArrayRef &aref) {
1174             return aref.base().IsSymbol() ||
1175                 aref.base().GetComponent().base().Rank() == 0;
1176           },
1177           [](const auto &) { return false; },
1178       },
1179       dataRef.u);
1180 }
1181
1182 void AccAttributeVisitor::AllowOnlyArrayAndSubArray(
1183     const parser::AccObjectList &objectList) {
1184   for (const auto &accObject : objectList.v) {
1185     common::visit(
1186         common::visitors{
1187             [&](const parser::Designator &designator) {
1188               if (!IsLastNameArray(designator)) {
1189                 context_.Say(designator.source,
1190                     "Only array element or subarray are allowed in %s directive"_err_en_US,
1191                     parser::ToUpperCaseLetters(
1192                         llvm::acc::getOpenACCDirectiveName(
1193                             GetContext().directive)
1194                             .str()));
1195               }
1196             },
1197             [&](const auto &name) {
1198               context_.Say(name.source,
1199                   "Only array element or subarray are allowed in %s directive"_err_en_US,
1200                   parser::ToUpperCaseLetters(
1201                       llvm::acc::getOpenACCDirectiveName(GetContext().directive)
1202                           .str()));
1203             },
1204         },
1205         accObject.u);
1206   }
1207 }
1208
1209 void AccAttributeVisitor::DoNotAllowAssumedSizedArray(
1210     const parser::AccObjectList &objectList) {
1211   for (const auto &accObject : objectList.v) {
1212     common::visit(
1213         common::visitors{
1214             [&](const parser::Designator &designator) {
1215               const auto &name{GetLastName(designator)};
1216               if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) {
1217                 context_.Say(designator.source,
1218                     "Assumed-size dummy arrays may not appear on the %s "
1219                     "directive"_err_en_US,
1220                     parser::ToUpperCaseLetters(
1221                         llvm::acc::getOpenACCDirectiveName(
1222                             GetContext().directive)
1223                             .str()));
1224               }
1225             },
1226             [&](const auto &name) {
1227
1228             },
1229         },
1230         accObject.u);
1231   }
1232 }
1233
1234 void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) {
1235   common::visit(
1236       common::visitors{
1237           [&](const parser::Designator &designator) {
1238             const auto &name{GetLastName(designator)};
1239             if (name.symbol && !semantics::IsVariableName(*name.symbol) &&
1240                 !semantics::IsNamedConstant(*name.symbol)) {
1241               context_.Say(designator.source,
1242                   "Only variables are allowed in data clauses on the %s "
1243                   "directive"_err_en_US,
1244                   parser::ToUpperCaseLetters(
1245                       llvm::acc::getOpenACCDirectiveName(GetContext().directive)
1246                           .str()));
1247             }
1248           },
1249           [&](const auto &name) {},
1250       },
1251       object.u);
1252 }
1253
1254 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
1255   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
1256   PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
1257   ClearDataSharingAttributeObjects();
1258
1259   const auto &objectListWithModifier =
1260       std::get<parser::AccObjectListWithModifier>(x.t);
1261   const auto &objectList =
1262       std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);
1263
1264   // 2.10 Cache directive restriction: A var in a cache directive must be a
1265   // single array element or a simple subarray.
1266   AllowOnlyArrayAndSubArray(objectList);
1267
1268   return true;
1269 }
1270
1271 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
1272     const parser::AccClauseList &x) {
1273   std::int64_t collapseLevel{0};
1274   for (const auto &clause : x.v) {
1275     if (const auto *collapseClause{
1276             std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
1277       const parser::AccCollapseArg &arg = collapseClause->v;
1278       const auto &collapseValue{std::get<parser::ScalarIntConstantExpr>(arg.t)};
1279       if (const auto v{EvaluateInt64(context_, collapseValue)}) {
1280         collapseLevel = *v;
1281       }
1282     }
1283   }
1284
1285   if (collapseLevel) {
1286     return collapseLevel;
1287   }
1288   return 1; // default is outermost loop
1289 }
1290
1291 void AccAttributeVisitor::CheckAssociatedLoop(
1292     const parser::DoConstruct &outerDoConstruct) {
1293   std::int64_t level{GetContext().associatedLoopLevel};
1294   if (level <= 0) { // collapse value was negative or 0
1295     return;
1296   }
1297
1298   const auto getNextDoConstruct =
1299       [this](const parser::Block &block,
1300           std::int64_t &level) -> const parser::DoConstruct * {
1301     for (const auto &entry : block) {
1302       if (const auto *doConstruct = GetDoConstructIf(entry)) {
1303         return doConstruct;
1304       } else if (parser::Unwrap<parser::CompilerDirective>(entry)) {
1305         // It is allowed to have a compiler directive associated with the loop.
1306         continue;
1307       } else if (const auto &accLoop{
1308                      parser::Unwrap<parser::OpenACCLoopConstruct>(entry)}) {
1309         if (level == 0)
1310           break;
1311         const auto &beginDir{
1312             std::get<parser::AccBeginLoopDirective>(accLoop->t)};
1313         context_.Say(beginDir.source,
1314             "LOOP directive not expected in COLLAPSE loop nest"_err_en_US);
1315         level = 0;
1316       } else {
1317         break;
1318       }
1319     }
1320     return nullptr;
1321   };
1322
1323   auto checkExprHasSymbols = [&](llvm::SmallVector<Symbol *> &ivs,
1324                                  semantics::UnorderedSymbolSet &symbols) {
1325     for (auto iv : ivs) {
1326       if (symbols.count(*iv) != 0) {
1327         context_.Say(GetContext().directiveSource,
1328             "Trip count must be computable and invariant"_err_en_US);
1329       }
1330     }
1331   };
1332
1333   Symbol::Flag flag = Symbol::Flag::AccPrivate;
1334   llvm::SmallVector<Symbol *> ivs;
1335   using Bounds = parser::LoopControl::Bounds;
1336   for (const parser::DoConstruct *loop{&outerDoConstruct}; loop && level > 0;) {
1337     // Go through all nested loops to ensure index variable exists.
1338     if (const parser::Name * ivName{GetLoopIndex(*loop)}) {
1339       if (auto *symbol{ResolveAcc(*ivName, flag, currScope())}) {
1340         if (auto &control{loop->GetLoopControl()}) {
1341           if (const Bounds * b{std::get_if<Bounds>(&control->u)}) {
1342             if (auto lowerExpr{semantics::AnalyzeExpr(context_, b->lower)}) {
1343               semantics::UnorderedSymbolSet lowerSyms =
1344                   evaluate::CollectSymbols(*lowerExpr);
1345               checkExprHasSymbols(ivs, lowerSyms);
1346             }
1347             if (auto upperExpr{semantics::AnalyzeExpr(context_, b->upper)}) {
1348               semantics::UnorderedSymbolSet upperSyms =
1349                   evaluate::CollectSymbols(*upperExpr);
1350               checkExprHasSymbols(ivs, upperSyms);
1351             }
1352           }
1353         }
1354         ivs.push_back(symbol);
1355       }
1356     }
1357
1358     const auto &block{std::get<parser::Block>(loop->t)};
1359     --level;
1360     loop = getNextDoConstruct(block, level);
1361   }
1362   CHECK(level == 0);
1363 }
1364
1365 void AccAttributeVisitor::EnsureAllocatableOrPointer(
1366     const llvm::acc::Clause clause, const parser::AccObjectList &objectList) {
1367   for (const auto &accObject : objectList.v) {
1368     common::visit(
1369         common::visitors{
1370             [&](const parser::Designator &designator) {
1371               const auto &lastName{GetLastName(designator)};
1372               if (!IsAllocatableOrObjectPointer(lastName.symbol)) {
1373                 context_.Say(designator.source,
1374                     "Argument `%s` on the %s clause must be a variable or "
1375                     "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
1376                     lastName.symbol->name(),
1377                     parser::ToUpperCaseLetters(
1378                         llvm::acc::getOpenACCClauseName(clause).str()));
1379               }
1380             },
1381             [&](const auto &name) {
1382               context_.Say(name.source,
1383                   "Argument on the %s clause must be a variable or "
1384                   "array with the POINTER or ALLOCATABLE attribute"_err_en_US,
1385                   parser::ToUpperCaseLetters(
1386                       llvm::acc::getOpenACCClauseName(clause).str()));
1387             },
1388         },
1389         accObject.u);
1390   }
1391 }
1392
1393 bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) {
1394   // Restriction - line 1708-1709
1395   EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v);
1396   return true;
1397 }
1398
1399 bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) {
1400   // Restriction - line 1715-1717
1401   EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v);
1402   return true;
1403 }
1404
1405 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
1406   if (!dirContext_.empty()) {
1407     switch (x.v) {
1408     case llvm::acc::DefaultValue::ACC_Default_present:
1409       SetContextDefaultDSA(Symbol::Flag::AccPresent);
1410       break;
1411     case llvm::acc::DefaultValue::ACC_Default_none:
1412       SetContextDefaultDSA(Symbol::Flag::AccNone);
1413       break;
1414     }
1415   }
1416 }
1417
1418 // For OpenACC constructs, check all the data-refs within the constructs
1419 // and adjust the symbol for each Name if necessary
1420 void AccAttributeVisitor::Post(const parser::Name &name) {
1421   auto *symbol{name.symbol};
1422   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
1423     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
1424         !symbol->has<SubprogramDetails>() && !IsObjectWithDSA(*symbol)) {
1425       if (Symbol * found{currScope().FindSymbol(name.source)}) {
1426         if (symbol != found) {
1427           name.symbol = found; // adjust the symbol within region
1428         } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
1429           // 2.5.14.
1430           context_.Say(name.source,
1431               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
1432               "a data-mapping clause"_err_en_US,
1433               symbol->name());
1434         }
1435       }
1436     }
1437   } // within OpenACC construct
1438 }
1439
1440 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
1441     const parser::Name *name) {
1442   if (auto *prev{name
1443               ? GetContext().scope.parent().FindCommonBlock(name->source)
1444               : nullptr}) {
1445     name->symbol = prev;
1446     return prev;
1447   }
1448   // Check if the Common Block is declared in the current scope
1449   if (auto *commonBlockSymbol{
1450           name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
1451     name->symbol = commonBlockSymbol;
1452     return commonBlockSymbol;
1453   }
1454   return nullptr;
1455 }
1456
1457 void AccAttributeVisitor::ResolveAccObjectList(
1458     const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
1459   for (const auto &accObject : accObjectList.v) {
1460     AllowOnlyVariable(accObject);
1461     ResolveAccObject(accObject, accFlag);
1462   }
1463 }
1464
1465 void AccAttributeVisitor::ResolveAccObject(
1466     const parser::AccObject &accObject, Symbol::Flag accFlag) {
1467   common::visit(
1468       common::visitors{
1469           [&](const parser::Designator &designator) {
1470             if (const auto *name{
1471                     semantics::getDesignatorNameIfDataRef(designator)}) {
1472               if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {
1473                 AddToContextObjectWithDSA(*symbol, accFlag);
1474                 if (dataSharingAttributeFlags.test(accFlag)) {
1475                   CheckMultipleAppearances(*name, *symbol, accFlag);
1476                 }
1477               }
1478             } else {
1479               // Array sections to be changed to substrings as needed
1480               if (AnalyzeExpr(context_, designator)) {
1481                 if (std::holds_alternative<parser::Substring>(designator.u)) {
1482                   context_.Say(designator.source,
1483                       "Substrings are not allowed on OpenACC "
1484                       "directives or clauses"_err_en_US);
1485                 }
1486               }
1487               // other checks, more TBD
1488             }
1489           },
1490           [&](const parser::Name &name) { // common block
1491             if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
1492               CheckMultipleAppearances(
1493                   name, *symbol, Symbol::Flag::AccCommonBlock);
1494               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
1495                 if (auto *resolvedObject{
1496                         ResolveAcc(*object, accFlag, currScope())}) {
1497                   AddToContextObjectWithDSA(*resolvedObject, accFlag);
1498                 }
1499               }
1500             } else {
1501               context_.Say(name.source,
1502                   "COMMON block must be declared in the same scoping unit "
1503                   "in which the OpenACC directive or clause appears"_err_en_US);
1504             }
1505           },
1506       },
1507       accObject.u);
1508 }
1509
1510 Symbol *AccAttributeVisitor::ResolveAcc(
1511     const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
1512   return DeclareOrMarkOtherAccessEntity(name, accFlag);
1513 }
1514
1515 Symbol *AccAttributeVisitor::ResolveAcc(
1516     Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
1517   return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
1518 }
1519
1520 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1521     const parser::Name &name, Symbol::Flag accFlag) {
1522   Symbol *prev{currScope().FindSymbol(name.source)};
1523   if (!name.symbol || !prev) {
1524     return nullptr;
1525   } else if (prev != name.symbol) {
1526     name.symbol = prev;
1527   }
1528   return DeclareOrMarkOtherAccessEntity(*prev, accFlag);
1529 }
1530
1531 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1532     Symbol &object, Symbol::Flag accFlag) {
1533   if (accFlagsRequireMark.test(accFlag)) {
1534     if (GetContext().directive == llvm::acc::ACCD_declare) {
1535       object.set(Symbol::Flag::AccDeclare);
1536       object.set(accFlag);
1537     }
1538   }
1539   return &object;
1540 }
1541
1542 static bool WithMultipleAppearancesAccException(
1543     const Symbol &symbol, Symbol::Flag flag) {
1544   return false; // Place holder
1545 }
1546
1547 void AccAttributeVisitor::CheckMultipleAppearances(
1548     const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {
1549   const auto *target{&symbol};
1550   if (HasDataSharingAttributeObject(*target) &&
1551       !WithMultipleAppearancesAccException(symbol, accFlag)) {
1552     context_.Say(name.source,
1553         "'%s' appears in more than one data-sharing clause "
1554         "on the same OpenACC directive"_err_en_US,
1555         name.ToString());
1556   } else {
1557     AddDataSharingAttributeObject(*target);
1558   }
1559 }
1560
1561 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1562   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1563   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1564   switch (beginDir.v) {
1565   case llvm::omp::Directive::OMPD_masked:
1566   case llvm::omp::Directive::OMPD_parallel_masked:
1567   case llvm::omp::Directive::OMPD_master:
1568   case llvm::omp::Directive::OMPD_parallel_master:
1569   case llvm::omp::Directive::OMPD_ordered:
1570   case llvm::omp::Directive::OMPD_parallel:
1571   case llvm::omp::Directive::OMPD_scope:
1572   case llvm::omp::Directive::OMPD_single:
1573   case llvm::omp::Directive::OMPD_target:
1574   case llvm::omp::Directive::OMPD_target_data:
1575   case llvm::omp::Directive::OMPD_task:
1576   case llvm::omp::Directive::OMPD_taskgroup:
1577   case llvm::omp::Directive::OMPD_teams:
1578   case llvm::omp::Directive::OMPD_workshare:
1579   case llvm::omp::Directive::OMPD_parallel_workshare:
1580   case llvm::omp::Directive::OMPD_target_teams:
1581   case llvm::omp::Directive::OMPD_target_parallel:
1582     PushContext(beginDir.source, beginDir.v);
1583     break;
1584   default:
1585     // TODO others
1586     break;
1587   }
1588   if (beginDir.v == llvm::omp::Directive::OMPD_master ||
1589       beginDir.v == llvm::omp::Directive::OMPD_parallel_master)
1590     IssueNonConformanceWarning(beginDir.v, beginDir.source);
1591   ClearDataSharingAttributeObjects();
1592   ClearPrivateDataSharingAttributeObjects();
1593   ClearAllocateNames();
1594   return true;
1595 }
1596
1597 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1598   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1599   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1600   switch (beginDir.v) {
1601   case llvm::omp::Directive::OMPD_masked:
1602   case llvm::omp::Directive::OMPD_master:
1603   case llvm::omp::Directive::OMPD_parallel_masked:
1604   case llvm::omp::Directive::OMPD_parallel_master:
1605   case llvm::omp::Directive::OMPD_parallel:
1606   case llvm::omp::Directive::OMPD_scope:
1607   case llvm::omp::Directive::OMPD_single:
1608   case llvm::omp::Directive::OMPD_target:
1609   case llvm::omp::Directive::OMPD_task:
1610   case llvm::omp::Directive::OMPD_teams:
1611   case llvm::omp::Directive::OMPD_parallel_workshare:
1612   case llvm::omp::Directive::OMPD_target_teams:
1613   case llvm::omp::Directive::OMPD_target_parallel: {
1614     bool hasPrivate;
1615     for (const auto *allocName : allocateNames_) {
1616       hasPrivate = false;
1617       for (auto privateObj : privateDataSharingAttributeObjects_) {
1618         const Symbol &symbolPrivate{*privateObj};
1619         if (allocName->source == symbolPrivate.name()) {
1620           hasPrivate = true;
1621           break;
1622         }
1623       }
1624       if (!hasPrivate) {
1625         context_.Say(allocName->source,
1626             "The ALLOCATE clause requires that '%s' must be listed in a "
1627             "private "
1628             "data-sharing attribute clause on the same directive"_err_en_US,
1629             allocName->ToString());
1630       }
1631     }
1632     break;
1633   }
1634   default:
1635     break;
1636   }
1637   PopContext();
1638 }
1639
1640 bool OmpAttributeVisitor::Pre(
1641     const parser::OpenMPSimpleStandaloneConstruct &x) {
1642   const auto &standaloneDir{
1643       std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
1644   switch (standaloneDir.v) {
1645   case llvm::omp::Directive::OMPD_barrier:
1646   case llvm::omp::Directive::OMPD_ordered:
1647   case llvm::omp::Directive::OMPD_scan:
1648   case llvm::omp::Directive::OMPD_target_enter_data:
1649   case llvm::omp::Directive::OMPD_target_exit_data:
1650   case llvm::omp::Directive::OMPD_target_update:
1651   case llvm::omp::Directive::OMPD_taskwait:
1652   case llvm::omp::Directive::OMPD_taskyield:
1653     PushContext(standaloneDir.source, standaloneDir.v);
1654     break;
1655   default:
1656     break;
1657   }
1658   ClearDataSharingAttributeObjects();
1659   return true;
1660 }
1661
1662 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
1663   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1664   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
1665   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1666   switch (beginDir.v) {
1667   case llvm::omp::Directive::OMPD_distribute:
1668   case llvm::omp::Directive::OMPD_distribute_parallel_do:
1669   case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
1670   case llvm::omp::Directive::OMPD_distribute_simd:
1671   case llvm::omp::Directive::OMPD_do:
1672   case llvm::omp::Directive::OMPD_do_simd:
1673   case llvm::omp::Directive::OMPD_loop:
1674   case llvm::omp::Directive::OMPD_masked_taskloop_simd:
1675   case llvm::omp::Directive::OMPD_masked_taskloop:
1676   case llvm::omp::Directive::OMPD_master_taskloop_simd:
1677   case llvm::omp::Directive::OMPD_master_taskloop:
1678   case llvm::omp::Directive::OMPD_parallel_do:
1679   case llvm::omp::Directive::OMPD_parallel_do_simd:
1680   case llvm::omp::Directive::OMPD_parallel_masked_taskloop_simd:
1681   case llvm::omp::Directive::OMPD_parallel_masked_taskloop:
1682   case llvm::omp::Directive::OMPD_parallel_master_taskloop_simd:
1683   case llvm::omp::Directive::OMPD_parallel_master_taskloop:
1684   case llvm::omp::Directive::OMPD_simd:
1685   case llvm::omp::Directive::OMPD_target_loop:
1686   case llvm::omp::Directive::OMPD_target_parallel_do:
1687   case llvm::omp::Directive::OMPD_target_parallel_do_simd:
1688   case llvm::omp::Directive::OMPD_target_parallel_loop:
1689   case llvm::omp::Directive::OMPD_target_teams_distribute:
1690   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
1691   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
1692   case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
1693   case llvm::omp::Directive::OMPD_target_teams_loop:
1694   case llvm::omp::Directive::OMPD_target_simd:
1695   case llvm::omp::Directive::OMPD_taskloop:
1696   case llvm::omp::Directive::OMPD_taskloop_simd:
1697   case llvm::omp::Directive::OMPD_teams_distribute:
1698   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
1699   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
1700   case llvm::omp::Directive::OMPD_teams_distribute_simd:
1701   case llvm::omp::Directive::OMPD_teams_loop:
1702   case llvm::omp::Directive::OMPD_tile:
1703   case llvm::omp::Directive::OMPD_unroll:
1704     PushContext(beginDir.source, beginDir.v);
1705     break;
1706   default:
1707     break;
1708   }
1709   if (beginDir.v == llvm::omp::OMPD_master_taskloop ||
1710       beginDir.v == llvm::omp::OMPD_master_taskloop_simd ||
1711       beginDir.v == llvm::omp::OMPD_parallel_master_taskloop ||
1712       beginDir.v == llvm::omp::OMPD_parallel_master_taskloop_simd ||
1713       beginDir.v == llvm::omp::Directive::OMPD_target_loop)
1714     IssueNonConformanceWarning(beginDir.v, beginDir.source);
1715   ClearDataSharingAttributeObjects();
1716   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
1717
1718   if (beginDir.v == llvm::omp::Directive::OMPD_do) {
1719     if (const auto &doConstruct{
1720             std::get<std::optional<parser::DoConstruct>>(x.t)}) {
1721       if (doConstruct.value().IsDoWhile()) {
1722         return true;
1723       }
1724     }
1725   }
1726   PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
1727   ordCollapseLevel = GetAssociatedLoopLevelFromClauses(clauseList) + 1;
1728   return true;
1729 }
1730
1731 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
1732     const parser::Name &iv) {
1733   // Find the parallel or task generating construct enclosing the
1734   // sequential loop.
1735   auto targetIt{dirContext_.rbegin()};
1736   for (;; ++targetIt) {
1737     if (targetIt == dirContext_.rend()) {
1738       return;
1739     }
1740     if (llvm::omp::allParallelSet.test(targetIt->directive) ||
1741         llvm::omp::taskGeneratingSet.test(targetIt->directive)) {
1742       break;
1743     }
1744   }
1745   // If this symbol already has a data-sharing attribute then there is nothing
1746   // to do here.
1747   if (const Symbol * symbol{iv.symbol}) {
1748     for (auto symMap : targetIt->objectWithDSA) {
1749       if (symMap.first->name() == symbol->name()) {
1750         return;
1751       }
1752     }
1753   }
1754   // If this symbol is already Private or Firstprivate in the enclosing
1755   // OpenMP parallel or task then there is nothing to do here.
1756   if (auto *symbol{targetIt->scope.FindSymbol(iv.source)}) {
1757     if (symbol->owner() == targetIt->scope) {
1758       if (symbol->test(Symbol::Flag::OmpPrivate) ||
1759           symbol->test(Symbol::Flag::OmpFirstPrivate)) {
1760         return;
1761       }
1762     }
1763   }
1764   // Otherwise find the symbol and make it Private for the entire enclosing
1765   // parallel or task
1766   if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {
1767     targetIt++;
1768     symbol->set(Symbol::Flag::OmpPreDetermined);
1769     iv.symbol = symbol; // adjust the symbol within region
1770     for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {
1771       AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);
1772     }
1773   }
1774 }
1775
1776 // [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined
1777 //   - A loop iteration variable for a sequential loop in a parallel
1778 //     or task generating construct is private in the innermost such
1779 //     construct that encloses the loop
1780 // Loop iteration variables are not well defined for DO WHILE loop.
1781 // Use of DO CONCURRENT inside OpenMP construct is unspecified behavior
1782 // till OpenMP-5.0 standard.
1783 // In above both cases we skip the privatization of iteration variables.
1784 // [OpenMP 5.1] DO CONCURRENT indices are private
1785 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
1786   if (!dirContext_.empty() && GetContext().withinConstruct) {
1787     llvm::SmallVector<const parser::Name *> ivs;
1788     if (x.IsDoNormal()) {
1789       const parser::Name *iv{GetLoopIndex(x)};
1790       if (iv && iv->symbol)
1791         ivs.push_back(iv);
1792     } else if (x.IsDoConcurrent()) {
1793       const Fortran::parser::LoopControl *loopControl = &*x.GetLoopControl();
1794       const Fortran::parser::LoopControl::Concurrent &concurrent =
1795           std::get<Fortran::parser::LoopControl::Concurrent>(loopControl->u);
1796       const Fortran::parser::ConcurrentHeader &concurrentHeader =
1797           std::get<Fortran::parser::ConcurrentHeader>(concurrent.t);
1798       const std::list<Fortran::parser::ConcurrentControl> &controls =
1799           std::get<std::list<Fortran::parser::ConcurrentControl>>(
1800               concurrentHeader.t);
1801       for (const auto &control : controls) {
1802         const parser::Name *iv{&std::get<0>(control.t)};
1803         if (iv && iv->symbol)
1804           ivs.push_back(iv);
1805       }
1806     }
1807     ordCollapseLevel--;
1808     for (auto iv : ivs) {
1809       if (!iv->symbol->test(Symbol::Flag::OmpPreDetermined)) {
1810         ResolveSeqLoopIndexInParallelOrTaskConstruct(*iv);
1811       } else {
1812         // TODO: conflict checks with explicitly determined DSA
1813       }
1814       if (ordCollapseLevel) {
1815         if (const auto *details{iv->symbol->detailsIf<HostAssocDetails>()}) {
1816           const Symbol *tpSymbol = &details->symbol();
1817           // TODO: DoConcurrent won't capture the following check because a new
1818           // symbol is declared in ResolveIndexName(), which will not have the
1819           // OmpThreadprivate flag.
1820           if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) {
1821             context_.Say(iv->source,
1822                 "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US,
1823                 iv->ToString());
1824           }
1825         }
1826       }
1827     }
1828   }
1829   return true;
1830 }
1831
1832 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
1833     const parser::OmpClauseList &x) {
1834   std::int64_t orderedLevel{0};
1835   std::int64_t collapseLevel{0};
1836
1837   const parser::OmpClause *ordClause{nullptr};
1838   const parser::OmpClause *collClause{nullptr};
1839
1840   for (const auto &clause : x.v) {
1841     if (const auto *orderedClause{
1842             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
1843       if (const auto v{EvaluateInt64(context_, orderedClause->v)}) {
1844         orderedLevel = *v;
1845       }
1846       ordClause = &clause;
1847     }
1848     if (const auto *collapseClause{
1849             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
1850       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
1851         collapseLevel = *v;
1852       }
1853       collClause = &clause;
1854     }
1855   }
1856
1857   if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
1858     SetAssociatedClause(*ordClause);
1859     return orderedLevel;
1860   } else if (!orderedLevel && collapseLevel) {
1861     SetAssociatedClause(*collClause);
1862     return collapseLevel;
1863   } // orderedLevel < collapseLevel is an error handled in structural checks
1864   return 1; // default is outermost loop
1865 }
1866
1867 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
1868 //   - The loop iteration variable(s) in the associated do-loop(s) of a do,
1869 //     parallel do, taskloop, or distribute construct is (are) private.
1870 //   - The loop iteration variable in the associated do-loop of a simd construct
1871 //     with just one associated do-loop is linear with a linear-step that is the
1872 //     increment of the associated do-loop.
1873 //   - The loop iteration variables in the associated do-loops of a simd
1874 //     construct with multiple associated do-loops are lastprivate.
1875 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
1876     const parser::OpenMPLoopConstruct &x) {
1877   std::int64_t level{GetContext().associatedLoopLevel};
1878   if (level <= 0) {
1879     return;
1880   }
1881   Symbol::Flag ivDSA;
1882   if (!llvm::omp::allSimdSet.test(GetContext().directive)) {
1883     ivDSA = Symbol::Flag::OmpPrivate;
1884   } else if (level == 1) {
1885     ivDSA = Symbol::Flag::OmpLinear;
1886   } else {
1887     ivDSA = Symbol::Flag::OmpLastPrivate;
1888   }
1889
1890   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
1891   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
1892     // go through all the nested do-loops and resolve index variables
1893     const parser::Name *iv{GetLoopIndex(*loop)};
1894     if (iv) {
1895       if (auto *symbol{ResolveOmp(*iv, ivDSA, currScope())}) {
1896         symbol->set(Symbol::Flag::OmpPreDetermined);
1897         iv->symbol = symbol; // adjust the symbol within region
1898         AddToContextObjectWithDSA(*symbol, ivDSA);
1899       }
1900
1901       const auto &block{std::get<parser::Block>(loop->t)};
1902       const auto it{block.begin()};
1903       loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
1904     }
1905   }
1906   CheckAssocLoopLevel(level, GetAssociatedClause());
1907 }
1908 void OmpAttributeVisitor::CheckAssocLoopLevel(
1909     std::int64_t level, const parser::OmpClause *clause) {
1910   if (clause && level != 0) {
1911     context_.Say(clause->source,
1912         "The value of the parameter in the COLLAPSE or ORDERED clause must"
1913         " not be larger than the number of nested loops"
1914         " following the construct."_err_en_US);
1915   }
1916 }
1917
1918 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
1919   const auto &beginSectionsDir{
1920       std::get<parser::OmpBeginSectionsDirective>(x.t)};
1921   const auto &beginDir{
1922       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1923   switch (beginDir.v) {
1924   case llvm::omp::Directive::OMPD_parallel_sections:
1925   case llvm::omp::Directive::OMPD_sections:
1926     PushContext(beginDir.source, beginDir.v);
1927     GetContext().withinConstruct = true;
1928     break;
1929   default:
1930     break;
1931   }
1932   ClearDataSharingAttributeObjects();
1933   return true;
1934 }
1935
1936 bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) {
1937   const auto &beginCriticalDir{std::get<parser::OmpCriticalDirective>(x.t)};
1938   const auto &endCriticalDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
1939   PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical);
1940   GetContext().withinConstruct = true;
1941   if (const auto &criticalName{
1942           std::get<std::optional<parser::Name>>(beginCriticalDir.t)}) {
1943     ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock);
1944   }
1945   if (const auto &endCriticalName{
1946           std::get<std::optional<parser::Name>>(endCriticalDir.t)}) {
1947     ResolveOmpName(*endCriticalName, Symbol::Flag::OmpCriticalLock);
1948   }
1949   return true;
1950 }
1951
1952 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareTargetConstruct &x) {
1953   PushContext(x.source, llvm::omp::Directive::OMPD_declare_target);
1954   const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1955   if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1956     ResolveOmpObjectList(*objectList, Symbol::Flag::OmpDeclareTarget);
1957   } else if (const auto *clauseList{
1958                  parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1959     for (const auto &clause : clauseList->v) {
1960       if (const auto *toClause{std::get_if<parser::OmpClause::To>(&clause.u)}) {
1961         auto &objList{std::get<parser::OmpObjectList>(toClause->v.t)};
1962         ResolveOmpObjectList(objList, Symbol::Flag::OmpDeclareTarget);
1963       } else if (const auto *linkClause{
1964                      std::get_if<parser::OmpClause::Link>(&clause.u)}) {
1965         ResolveOmpObjectList(linkClause->v, Symbol::Flag::OmpDeclareTarget);
1966       } else if (const auto *enterClause{
1967                      std::get_if<parser::OmpClause::Enter>(&clause.u)}) {
1968         ResolveOmpObjectList(enterClause->v, Symbol::Flag::OmpDeclareTarget);
1969       }
1970     }
1971   }
1972   return true;
1973 }
1974
1975 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {
1976   PushContext(x.source, llvm::omp::Directive::OMPD_declare_mapper);
1977   return true;
1978 }
1979
1980 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
1981   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
1982   const auto &list{std::get<parser::OmpObjectList>(x.t)};
1983   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
1984   return true;
1985 }
1986
1987 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
1988   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
1989   const auto &list{std::get<parser::OmpObjectList>(x.t)};
1990   ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective);
1991   return false;
1992 }
1993
1994 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
1995   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
1996   const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1997   if (list) {
1998     ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
1999   }
2000   return true;
2001 }
2002
2003 bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) {
2004   PushContext(x.source, llvm::omp::Directive::OMPD_allocators);
2005   const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2006   for (const auto &clause : clauseList.v) {
2007     if (const auto *allocClause{
2008             std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
2009       ResolveOmpObjectList(std::get<parser::OmpObjectList>(allocClause->v.t),
2010           Symbol::Flag::OmpExecutableAllocateDirective);
2011     }
2012   }
2013   return true;
2014 }
2015
2016 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
2017   if (!dirContext_.empty()) {
2018     switch (x.v) {
2019     case parser::OmpDefaultClause::Type::Private:
2020       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
2021       break;
2022     case parser::OmpDefaultClause::Type::Firstprivate:
2023       SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
2024       break;
2025     case parser::OmpDefaultClause::Type::Shared:
2026       SetContextDefaultDSA(Symbol::Flag::OmpShared);
2027       break;
2028     case parser::OmpDefaultClause::Type::None:
2029       SetContextDefaultDSA(Symbol::Flag::OmpNone);
2030       break;
2031     }
2032   }
2033 }
2034
2035 bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) {
2036   if (dirContext_.size() >= 1) {
2037     for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
2038       if (dirContext_[i - 1].directive == directive) {
2039         return true;
2040       }
2041     }
2042   }
2043   return false;
2044 }
2045
2046 void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
2047   bool hasAllocator = false;
2048   // TODO: Investigate whether searching the clause list can be done with
2049   // parser::Unwrap instead of the following loop
2050   const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2051   for (const auto &clause : clauseList.v) {
2052     if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) {
2053       hasAllocator = true;
2054     }
2055   }
2056
2057   if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) {
2058     // TODO: expand this check to exclude the case when a requires
2059     //       directive with the dynamic_allocators clause is present
2060     //       in the same compilation unit (OMP5.0 2.11.3).
2061     context_.Say(x.source,
2062         "ALLOCATE directives that appear in a TARGET region "
2063         "must specify an allocator clause"_err_en_US);
2064   }
2065
2066   const auto &allocateStmt =
2067       std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement;
2068   if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
2069     CheckAllNamesInAllocateStmt(
2070         std::get<parser::Verbatim>(x.t).source, *list, allocateStmt);
2071   }
2072   if (const auto &subDirs{
2073           std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
2074               x.t)}) {
2075     for (const auto &dalloc : *subDirs) {
2076       CheckAllNamesInAllocateStmt(std::get<parser::Verbatim>(dalloc.t).source,
2077           std::get<parser::OmpObjectList>(dalloc.t), allocateStmt);
2078     }
2079   }
2080   PopContext();
2081 }
2082
2083 void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) {
2084   const auto &dir{std::get<parser::Verbatim>(x.t)};
2085   const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2086   for (const auto &clause : clauseList.v) {
2087     if (const auto *alloc{
2088             std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
2089       CheckAllNamesInAllocateStmt(dir.source,
2090           std::get<parser::OmpObjectList>(alloc->v.t),
2091           std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement);
2092
2093       const auto &allocMod{
2094           std::get<std::optional<parser::OmpAllocateClause::AllocateModifier>>(
2095               alloc->v.t)};
2096       // TODO: As with allocate directive, exclude the case when a requires
2097       //       directive with the dynamic_allocators clause is present in
2098       //       the same compilation unit (OMP5.0 2.11.3).
2099       if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) &&
2100           (!allocMod.has_value() ||
2101               std::holds_alternative<
2102                   parser::OmpAllocateClause::AllocateModifier::Align>(
2103                   allocMod->u))) {
2104         context_.Say(x.source,
2105             "ALLOCATORS directives that appear in a TARGET region "
2106             "must specify an allocator"_err_en_US);
2107       }
2108     }
2109   }
2110   PopContext();
2111 }
2112
2113 static bool IsPrivatizable(const Symbol *sym) {
2114   auto *misc{sym->detailsIf<MiscDetails>()};
2115   return !IsProcedure(*sym) && !IsNamedConstant(*sym) &&
2116       !semantics::IsAssumedSizeArray(
2117           *sym) && /* OpenMP 5.2, 5.1.1: Assumed-size arrays are shared*/
2118       !sym->owner().IsDerivedType() &&
2119       sym->owner().kind() != Scope::Kind::ImpliedDos &&
2120       !sym->detailsIf<semantics::AssocEntityDetails>() &&
2121       !sym->detailsIf<semantics::NamelistDetails>() &&
2122       (!misc ||
2123           (misc->kind() != MiscDetails::Kind::ComplexPartRe &&
2124               misc->kind() != MiscDetails::Kind::ComplexPartIm &&
2125               misc->kind() != MiscDetails::Kind::KindParamInquiry &&
2126               misc->kind() != MiscDetails::Kind::LenParamInquiry &&
2127               misc->kind() != MiscDetails::Kind::ConstructName));
2128 }
2129
2130 void OmpAttributeVisitor::CreateImplicitSymbols(
2131     const Symbol *symbol, std::optional<Symbol::Flag> setFlag) {
2132   if (!IsPrivatizable(symbol)) {
2133     return;
2134   }
2135
2136   // Implicitly determined DSAs
2137   // OMP 5.2 5.1.1 - Variables Referenced in a Construct
2138   Symbol *lastDeclSymbol = nullptr;
2139   std::optional<Symbol::Flag> prevDSA;
2140   for (int dirDepth{0}; dirDepth < (int)dirContext_.size(); ++dirDepth) {
2141     DirContext &dirContext = dirContext_[dirDepth];
2142     std::optional<Symbol::Flag> dsa;
2143
2144     for (auto symMap : dirContext.objectWithDSA) {
2145       // if the `symbol` already has a data-sharing attribute
2146       if (symMap.first->name() == symbol->name()) {
2147         dsa = symMap.second;
2148         break;
2149       }
2150     }
2151
2152     // When handling each implicit rule for a given symbol, one of the
2153     // following 3 actions may be taken:
2154     // 1. Declare a new private symbol.
2155     // 2. Create a new association symbol with no flags, that will represent
2156     //    a shared symbol in the current scope. Note that symbols without
2157     //    any private flags are considered as shared.
2158     // 3. Use the last declared private symbol, by inserting a new symbol
2159     //    in the scope being processed, associated with it.
2160     //    If no private symbol was declared previously, then no association
2161     //    is needed and the symbol from the enclosing scope will be
2162     //    inherited by the current one.
2163     //
2164     // Because of how symbols are collected in lowering, not inserting a new
2165     // symbol in the last case could lead to the conclusion that a symbol
2166     // from an enclosing construct was declared in the current construct,
2167     // which would result in wrong privatization code being generated.
2168     // Consider the following example:
2169     //
2170     // !$omp parallel default(private)              ! p1
2171     //   !$omp parallel default(private) shared(x)  ! p2
2172     //     x = 10
2173     //   !$omp end parallel
2174     // !$omp end parallel
2175     //
2176     // If a new x symbol was not inserted in the inner parallel construct
2177     // (p2), it would use the x symbol definition from the enclosing scope.
2178     // Then, when p2's default symbols were collected in lowering, the x
2179     // symbol from the outer parallel construct (p1) would be collected, as
2180     // it would have the private flag set.
2181     // This would make x appear to be defined in p2, causing it to be
2182     // privatized in p2 and its privatization in p1 to be skipped.
2183     auto makePrivateSymbol = [&](Symbol::Flag flag) {
2184       const Symbol *hostSymbol =
2185           lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();
2186       lastDeclSymbol = DeclareNewPrivateAccessEntity(
2187           *hostSymbol, flag, context_.FindScope(dirContext.directiveSource));
2188       if (setFlag) {
2189         lastDeclSymbol->set(*setFlag);
2190       }
2191       return lastDeclSymbol;
2192     };
2193     auto makeSharedSymbol = [&](std::optional<Symbol::Flag> flag = {}) {
2194       const Symbol *hostSymbol =
2195           lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();
2196       Symbol &assocSymbol = MakeAssocSymbol(symbol->name(), *hostSymbol,
2197           context_.FindScope(dirContext.directiveSource));
2198       if (flag) {
2199         assocSymbol.set(*flag);
2200       }
2201     };
2202     auto useLastDeclSymbol = [&]() {
2203       if (lastDeclSymbol) {
2204         makeSharedSymbol();
2205       }
2206     };
2207
2208     bool taskGenDir = llvm::omp::taskGeneratingSet.test(dirContext.directive);
2209     bool targetDir = llvm::omp::allTargetSet.test(dirContext.directive);
2210     bool parallelDir = llvm::omp::allParallelSet.test(dirContext.directive);
2211     bool teamsDir = llvm::omp::allTeamsSet.test(dirContext.directive);
2212
2213     if (dsa.has_value()) {
2214       if (dsa.value() == Symbol::Flag::OmpShared &&
2215           (parallelDir || taskGenDir || teamsDir)) {
2216         makeSharedSymbol(Symbol::Flag::OmpShared);
2217       }
2218       // Private symbols will have been declared already.
2219       prevDSA = dsa;
2220       continue;
2221     }
2222
2223     if (dirContext.defaultDSA == Symbol::Flag::OmpPrivate ||
2224         dirContext.defaultDSA == Symbol::Flag::OmpFirstPrivate ||
2225         dirContext.defaultDSA == Symbol::Flag::OmpShared) {
2226       // 1) default
2227       // Allowed only with parallel, teams and task generating constructs.
2228       if (!parallelDir && !taskGenDir && !teamsDir) {
2229         return;
2230       }
2231       if (dirContext.defaultDSA != Symbol::Flag::OmpShared) {
2232         makePrivateSymbol(dirContext.defaultDSA);
2233       } else {
2234         makeSharedSymbol();
2235       }
2236       dsa = dirContext.defaultDSA;
2237     } else if (parallelDir) {
2238       // 2) parallel -> shared
2239       makeSharedSymbol();
2240       dsa = Symbol::Flag::OmpShared;
2241     } else if (!taskGenDir && !targetDir) {
2242       // 3) enclosing context
2243       useLastDeclSymbol();
2244       dsa = prevDSA;
2245     } else if (targetDir) {
2246       // TODO 4) not mapped target variable -> firstprivate
2247       dsa = prevDSA;
2248     } else if (taskGenDir) {
2249       // TODO 5) dummy arg in orphaned taskgen construct -> firstprivate
2250       if (prevDSA == Symbol::Flag::OmpShared) {
2251         // 6) shared in enclosing context -> shared
2252         makeSharedSymbol();
2253         dsa = Symbol::Flag::OmpShared;
2254       } else {
2255         // 7) firstprivate
2256         dsa = Symbol::Flag::OmpFirstPrivate;
2257         makePrivateSymbol(*dsa)->set(Symbol::Flag::OmpImplicit);
2258       }
2259     }
2260     prevDSA = dsa;
2261   }
2262 }
2263
2264 // For OpenMP constructs, check all the data-refs within the constructs
2265 // and adjust the symbol for each Name if necessary
2266 void OmpAttributeVisitor::Post(const parser::Name &name) {
2267   auto *symbol{name.symbol};
2268
2269   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
2270     if (IsPrivatizable(symbol) && !IsObjectWithDSA(*symbol)) {
2271       // TODO: create a separate function to go through the rules for
2272       //       predetermined, explicitly determined, and implicitly
2273       //       determined data-sharing attributes (2.15.1.1).
2274       if (Symbol * found{currScope().FindSymbol(name.source)}) {
2275         if (symbol != found) {
2276           name.symbol = found; // adjust the symbol within region
2277         } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone &&
2278             !symbol->test(Symbol::Flag::OmpThreadprivate) &&
2279             // Exclude indices of sequential loops that are privatised in
2280             // the scope of the parallel region, and not in this scope.
2281             // TODO: check whether this should be caught in IsObjectWithDSA
2282             !symbol->test(Symbol::Flag::OmpPrivate)) {
2283           context_.Say(name.source,
2284               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
2285               "a data-sharing attribute clause"_err_en_US,
2286               symbol->name());
2287         }
2288       }
2289     }
2290
2291     if (Symbol * found{currScope().FindSymbol(name.source)}) {
2292       if (found->test(semantics::Symbol::Flag::OmpThreadprivate))
2293         return;
2294     }
2295
2296     CreateImplicitSymbols(symbol);
2297   } // within OpenMP construct
2298 }
2299
2300 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) {
2301   if (auto *resolvedSymbol{
2302           name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
2303     name->symbol = resolvedSymbol;
2304     return resolvedSymbol;
2305   } else {
2306     return nullptr;
2307   }
2308 }
2309
2310 void OmpAttributeVisitor::ResolveOmpName(
2311     const parser::Name &name, Symbol::Flag ompFlag) {
2312   if (ResolveName(&name)) {
2313     if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) {
2314       if (dataSharingAttributeFlags.test(ompFlag)) {
2315         AddToContextObjectWithDSA(*resolvedSymbol, ompFlag);
2316       }
2317     }
2318   } else if (ompFlag == Symbol::Flag::OmpCriticalLock) {
2319     const auto pair{
2320         GetContext().scope.try_emplace(name.source, Attrs{}, UnknownDetails{})};
2321     CHECK(pair.second);
2322     name.symbol = &pair.first->second.get();
2323   }
2324 }
2325
2326 void OmpAttributeVisitor::ResolveOmpNameList(
2327     const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) {
2328   for (const auto &name : nameList) {
2329     ResolveOmpName(name, ompFlag);
2330   }
2331 }
2332
2333 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
2334     const parser::Name *name) {
2335   if (!name) {
2336     return nullptr;
2337   }
2338   if (auto *cb{GetProgramUnitOrBlockConstructContaining(GetContext().scope)
2339                    .FindCommonBlock(name->source)}) {
2340     name->symbol = cb;
2341     return cb;
2342   }
2343   return nullptr;
2344 }
2345
2346 // Use this function over ResolveOmpName when an omp object's scope needs
2347 // resolving, it's symbol flag isn't important and a simple check for resolution
2348 // failure is desired. Using ResolveOmpName means needing to work with the
2349 // context to check for failure, whereas here a pointer comparison is all that's
2350 // needed.
2351 Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) {
2352
2353   // TODO: Investigate whether the following block can be replaced by, or
2354   // included in, the ResolveOmpName function
2355   if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source)
2356                       : nullptr}) {
2357     name->symbol = prev;
2358     return nullptr;
2359   }
2360
2361   // TODO: Investigate whether the following block can be replaced by, or
2362   // included in, the ResolveOmpName function
2363   if (auto *ompSymbol{
2364           name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
2365     name->symbol = ompSymbol;
2366     return ompSymbol;
2367   }
2368   return nullptr;
2369 }
2370
2371 void OmpAttributeVisitor::ResolveOmpObjectList(
2372     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
2373   for (const auto &ompObject : ompObjectList.v) {
2374     ResolveOmpObject(ompObject, ompFlag);
2375   }
2376 }
2377
2378 void OmpAttributeVisitor::ResolveOmpObject(
2379     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
2380   common::visit(
2381       common::visitors{
2382           [&](const parser::Designator &designator) {
2383             if (const auto *name{
2384                     semantics::getDesignatorNameIfDataRef(designator)}) {
2385               if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
2386                 auto checkExclusivelists =
2387                     [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,
2388                         const Symbol *symbol2, Symbol::Flag secondOmpFlag) {
2389                       if ((symbol1->test(firstOmpFlag) &&
2390                               symbol2->test(secondOmpFlag)) ||
2391                           (symbol1->test(secondOmpFlag) &&
2392                               symbol2->test(firstOmpFlag))) {
2393                         context_.Say(designator.source,
2394                             "Variable '%s' may not "
2395                             "appear on both %s and %s "
2396                             "clauses on a %s construct"_err_en_US,
2397                             symbol2->name(),
2398                             Symbol::OmpFlagToClauseName(firstOmpFlag),
2399                             Symbol::OmpFlagToClauseName(secondOmpFlag),
2400                             parser::ToUpperCaseLetters(
2401                                 llvm::omp::getOpenMPDirectiveName(
2402                                     GetContext().directive)
2403                                     .str()));
2404                       }
2405                     };
2406                 if (dataCopyingAttributeFlags.test(ompFlag)) {
2407                   CheckDataCopyingClause(*name, *symbol, ompFlag);
2408                 } else {
2409                   AddToContextObjectWithDSA(*symbol, ompFlag);
2410                   if (dataSharingAttributeFlags.test(ompFlag)) {
2411                     CheckMultipleAppearances(*name, *symbol, ompFlag);
2412                   }
2413                   if (privateDataSharingAttributeFlags.test(ompFlag)) {
2414                     CheckObjectIsPrivatizable(*name, *symbol, ompFlag);
2415                   }
2416
2417                   if (ompFlag == Symbol::Flag::OmpAllocate) {
2418                     AddAllocateName(name);
2419                   }
2420                 }
2421                 if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
2422                     IsAllocatable(*symbol) &&
2423                     !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) {
2424                   context_.Say(designator.source,
2425                       "List items specified in the ALLOCATE directive must not "
2426                       "have the ALLOCATABLE attribute unless the directive is "
2427                       "associated with an ALLOCATE statement"_err_en_US);
2428                 }
2429                 if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
2430                         ompFlag ==
2431                             Symbol::Flag::OmpExecutableAllocateDirective) &&
2432                     ResolveOmpObjectScope(name) == nullptr) {
2433                   context_.Say(designator.source, // 2.15.3
2434                       "List items must be declared in the same scoping unit "
2435                       "in which the %s directive appears"_err_en_US,
2436                       parser::ToUpperCaseLetters(
2437                           llvm::omp::getOpenMPDirectiveName(
2438                               GetContext().directive)
2439                               .str()));
2440                 }
2441                 if (ompFlag == Symbol::Flag::OmpReduction) {
2442                   const Symbol &ultimateSymbol{symbol->GetUltimate()};
2443                   // Using variables inside of a namelist in OpenMP reductions
2444                   // is allowed by the standard, but is not allowed for
2445                   // privatisation. This looks like an oversight. If the
2446                   // namelist is hoisted to a global, we cannot apply the
2447                   // mapping for the reduction variable: resulting in incorrect
2448                   // results. Disabling this hoisting could make some real
2449                   // production code go slower. See discussion in #109303
2450                   if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
2451                     context_.Say(name->source,
2452                         "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,
2453                         name->ToString());
2454                   }
2455                 }
2456                 if (ompFlag == Symbol::Flag::OmpInclusiveScan ||
2457                     ompFlag == Symbol::Flag::OmpExclusiveScan) {
2458                   if (!symbol->test(Symbol::Flag::OmpInScanReduction)) {
2459                     context_.Say(name->source,
2460                         "List item %s must appear in REDUCTION clause "
2461                         "with the INSCAN modifier of the parent "
2462                         "directive"_err_en_US,
2463                         name->ToString());
2464                   }
2465                 }
2466                 if (GetContext().directive ==
2467                     llvm::omp::Directive::OMPD_target_data) {
2468                   checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr,
2469                       symbol, Symbol::Flag::OmpUseDeviceAddr);
2470                 }
2471                 if (llvm::omp::allDistributeSet.test(GetContext().directive)) {
2472                   checkExclusivelists(symbol, Symbol::Flag::OmpFirstPrivate,
2473                       symbol, Symbol::Flag::OmpLastPrivate);
2474                 }
2475                 if (llvm::omp::allTargetSet.test(GetContext().directive)) {
2476                   checkExclusivelists(symbol, Symbol::Flag::OmpIsDevicePtr,
2477                       symbol, Symbol::Flag::OmpHasDeviceAddr);
2478                   const auto *hostAssocSym{symbol};
2479                   if (!(symbol->test(Symbol::Flag::OmpIsDevicePtr) ||
2480                           symbol->test(Symbol::Flag::OmpHasDeviceAddr))) {
2481                     if (const auto *details{
2482                             symbol->detailsIf<HostAssocDetails>()}) {
2483                       hostAssocSym = &details->symbol();
2484                     }
2485                   }
2486                   Symbol::Flag dataMappingAttributeFlags[] = {
2487                       Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
2488                       Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapAlloc,
2489                       Symbol::Flag::OmpMapRelease, Symbol::Flag::OmpMapDelete,
2490                       Symbol::Flag::OmpIsDevicePtr,
2491                       Symbol::Flag::OmpHasDeviceAddr};
2492
2493                   Symbol::Flag dataSharingAttributeFlags[] = {
2494                       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
2495                       Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,
2496                       Symbol::Flag::OmpLinear};
2497
2498                   // For OMP TARGET TEAMS directive some sharing attribute
2499                   // flags and mapping attribute flags can co-exist.
2500                   if (!(llvm::omp::allTeamsSet.test(GetContext().directive) ||
2501                           llvm::omp::allParallelSet.test(
2502                               GetContext().directive))) {
2503                     for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {
2504                       for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {
2505                         checkExclusivelists(
2506                             hostAssocSym, ompFlag1, symbol, ompFlag2);
2507                       }
2508                     }
2509                   }
2510                 }
2511               }
2512             } else {
2513               // Array sections to be changed to substrings as needed
2514               if (AnalyzeExpr(context_, designator)) {
2515                 if (std::holds_alternative<parser::Substring>(designator.u)) {
2516                   context_.Say(designator.source,
2517                       "Substrings are not allowed on OpenMP "
2518                       "directives or clauses"_err_en_US);
2519                 }
2520               }
2521               // other checks, more TBD
2522             }
2523           },
2524           [&](const parser::Name &name) { // common block
2525             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
2526               if (!dataCopyingAttributeFlags.test(ompFlag)) {
2527                 CheckMultipleAppearances(
2528                     name, *symbol, Symbol::Flag::OmpCommonBlock);
2529               }
2530               // 2.15.3 When a named common block appears in a list, it has the
2531               // same meaning as if every explicit member of the common block
2532               // appeared in the list
2533               auto &details{symbol->get<CommonBlockDetails>()};
2534               unsigned index{0};
2535               for (auto &object : details.objects()) {
2536                 if (auto *resolvedObject{
2537                         ResolveOmp(*object, ompFlag, currScope())}) {
2538                   if (dataCopyingAttributeFlags.test(ompFlag)) {
2539                     CheckDataCopyingClause(name, *resolvedObject, ompFlag);
2540                   } else {
2541                     AddToContextObjectWithDSA(*resolvedObject, ompFlag);
2542                   }
2543                   details.replace_object(*resolvedObject, index);
2544                 }
2545                 index++;
2546               }
2547             } else {
2548               context_.Say(name.source, // 2.15.3
2549                   "COMMON block must be declared in the same scoping unit "
2550                   "in which the OpenMP directive or clause appears"_err_en_US);
2551             }
2552           },
2553       },
2554       ompObject.u);
2555 }
2556
2557 Symbol *OmpAttributeVisitor::ResolveOmp(
2558     const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {
2559   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
2560     return DeclarePrivateAccessEntity(name, ompFlag, scope);
2561   } else {
2562     return DeclareOrMarkOtherAccessEntity(name, ompFlag);
2563   }
2564 }
2565
2566 Symbol *OmpAttributeVisitor::ResolveOmp(
2567     Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {
2568   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
2569     return DeclarePrivateAccessEntity(symbol, ompFlag, scope);
2570   } else {
2571     return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
2572   }
2573 }
2574
2575 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
2576     const parser::Name &name, Symbol::Flag ompFlag) {
2577   Symbol *prev{currScope().FindSymbol(name.source)};
2578   if (!name.symbol || !prev) {
2579     return nullptr;
2580   } else if (prev != name.symbol) {
2581     name.symbol = prev;
2582   }
2583   return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
2584 }
2585
2586 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
2587     Symbol &object, Symbol::Flag ompFlag) {
2588   if (ompFlagsRequireMark.test(ompFlag)) {
2589     object.set(ompFlag);
2590   }
2591   return &object;
2592 }
2593
2594 static bool WithMultipleAppearancesOmpException(
2595     const Symbol &symbol, Symbol::Flag flag) {
2596   return (flag == Symbol::Flag::OmpFirstPrivate &&
2597              symbol.test(Symbol::Flag::OmpLastPrivate)) ||
2598       (flag == Symbol::Flag::OmpLastPrivate &&
2599           symbol.test(Symbol::Flag::OmpFirstPrivate));
2600 }
2601
2602 void OmpAttributeVisitor::CheckMultipleAppearances(
2603     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
2604   const auto *target{&symbol};
2605   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
2606     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
2607       target = &details->symbol();
2608     }
2609   }
2610   if (HasDataSharingAttributeObject(target->GetUltimate()) &&
2611       !WithMultipleAppearancesOmpException(symbol, ompFlag)) {
2612     context_.Say(name.source,
2613         "'%s' appears in more than one data-sharing clause "
2614         "on the same OpenMP directive"_err_en_US,
2615         name.ToString());
2616   } else {
2617     AddDataSharingAttributeObject(target->GetUltimate());
2618     if (privateDataSharingAttributeFlags.test(ompFlag)) {
2619       AddPrivateDataSharingAttributeObjects(*target);
2620     }
2621   }
2622 }
2623
2624 void ResolveAccParts(SemanticsContext &context, const parser::ProgramUnit &node,
2625     Scope *topScope) {
2626   if (context.IsEnabled(common::LanguageFeature::OpenACC)) {
2627     AccAttributeVisitor{context, topScope}.Walk(node);
2628   }
2629 }
2630
2631 void ResolveOmpParts(
2632     SemanticsContext &context, const parser::ProgramUnit &node) {
2633   if (context.IsEnabled(common::LanguageFeature::OpenMP)) {
2634     OmpAttributeVisitor{context}.Walk(node);
2635     if (!context.AnyFatalError()) {
2636       // The data-sharing attribute of the loop iteration variable for a
2637       // sequential loop (2.15.1.1) can only be determined when visiting
2638       // the corresponding DoConstruct, a second walk is to adjust the
2639       // symbols for all the data-refs of that loop iteration variable
2640       // prior to the DoConstruct.
2641       OmpAttributeVisitor{context}.Walk(node);
2642     }
2643   }
2644 }
2645
2646 void ResolveOmpTopLevelParts(
2647     SemanticsContext &context, const parser::Program &program) {
2648   if (!context.IsEnabled(common::LanguageFeature::OpenMP)) {
2649     return;
2650   }
2651
2652   // Gather REQUIRES clauses from all non-module top-level program unit symbols,
2653   // combine them together ensuring compatibility and apply them to all these
2654   // program units. Modules are skipped because their REQUIRES clauses should be
2655   // propagated via USE statements instead.
2656   WithOmpDeclarative::RequiresFlags combinedFlags;
2657   std::optional<common::OmpAtomicDefaultMemOrderType> combinedMemOrder;
2658
2659   // Function to go through non-module top level program units and extract
2660   // REQUIRES information to be processed by a function-like argument.
2661   auto processProgramUnits{[&](auto processFn) {
2662     for (const parser::ProgramUnit &unit : program.v) {
2663       if (!std::holds_alternative<common::Indirection<parser::Module>>(
2664               unit.u) &&
2665           !std::holds_alternative<common::Indirection<parser::Submodule>>(
2666               unit.u) &&
2667           !std::holds_alternative<
2668               common::Indirection<parser::CompilerDirective>>(unit.u)) {
2669         Symbol *symbol{common::visit(
2670             [&context](auto &x) {
2671               Scope *scope = GetScope(context, x.value());
2672               return scope ? scope->symbol() : nullptr;
2673             },
2674             unit.u)};
2675         // FIXME There is no symbol defined for MainProgram units in certain
2676         // circumstances, so REQUIRES information has no place to be stored in
2677         // these cases.
2678         if (!symbol) {
2679           continue;
2680         }
2681         common::visit(
2682             [&](auto &details) {
2683               if constexpr (std::is_convertible_v<decltype(&details),
2684                                 WithOmpDeclarative *>) {
2685                 processFn(*symbol, details);
2686               }
2687             },
2688             symbol->details());
2689       }
2690     }
2691   }};
2692
2693   // Combine global REQUIRES information from all program units except modules
2694   // and submodules.
2695   processProgramUnits([&](Symbol &symbol, WithOmpDeclarative &details) {
2696     if (const WithOmpDeclarative::RequiresFlags *
2697         flags{details.ompRequires()}) {
2698       combinedFlags |= *flags;
2699     }
2700     if (const common::OmpAtomicDefaultMemOrderType *
2701         memOrder{details.ompAtomicDefaultMemOrder()}) {
2702       if (combinedMemOrder && *combinedMemOrder != *memOrder) {
2703         context.Say(symbol.scope()->sourceRange(),
2704             "Conflicting '%s' REQUIRES clauses found in compilation "
2705             "unit"_err_en_US,
2706             parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
2707                 llvm::omp::Clause::OMPC_atomic_default_mem_order)
2708                                            .str()));
2709       }
2710       combinedMemOrder = *memOrder;
2711     }
2712   });
2713
2714   // Update all program units except modules and submodules with the combined
2715   // global REQUIRES information.
2716   processProgramUnits([&](Symbol &, WithOmpDeclarative &details) {
2717     if (combinedFlags.any()) {
2718       details.set_ompRequires(combinedFlags);
2719     }
2720     if (combinedMemOrder) {
2721       details.set_ompAtomicDefaultMemOrder(*combinedMemOrder);
2722     }
2723   });
2724 }
2725
2726 static bool IsSymbolInCommonBlock(const Symbol &symbol) {
2727   // TODO Improve the performance of this predicate function.
2728   //      Going through all symbols sequentially, in all common blocks, can be
2729   //      slow when there are many symbols. A possible optimization is to add
2730   //      an OmpInCommonBlock flag to Symbol, to make it possible to quickly
2731   //      test if a given symbol is in a common block.
2732   for (const auto &cb : symbol.owner().commonBlocks()) {
2733     if (IsCommonBlockContaining(cb.second.get(), symbol)) {
2734       return true;
2735     }
2736   }
2737   return false;
2738 }
2739
2740 static bool IsSymbolThreadprivate(const Symbol &symbol) {
2741   if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
2742     return details->symbol().test(Symbol::Flag::OmpThreadprivate);
2743   }
2744   return symbol.test(Symbol::Flag::OmpThreadprivate);
2745 }
2746
2747 static bool IsSymbolPrivate(const Symbol &symbol) {
2748   if (symbol.test(Symbol::Flag::OmpPrivate) ||
2749       symbol.test(Symbol::Flag::OmpFirstPrivate)) {
2750     return true;
2751   }
2752   // A symbol that has not gone through constructs that may privatize the
2753   // original symbol may be predetermined as private.
2754   // (OMP 5.2 5.1.1 - Variables Referenced in a Construct)
2755   if (symbol == symbol.GetUltimate()) {
2756     switch (symbol.owner().kind()) {
2757     case Scope::Kind::MainProgram:
2758     case Scope::Kind::Subprogram:
2759     case Scope::Kind::BlockConstruct:
2760       return !symbol.attrs().test(Attr::SAVE) &&
2761           !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) &&
2762           !IsSymbolInCommonBlock(symbol);
2763     default:
2764       return false;
2765     }
2766   }
2767   return false;
2768 }
2769
2770 void OmpAttributeVisitor::CheckDataCopyingClause(
2771     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
2772   if (ompFlag == Symbol::Flag::OmpCopyIn) {
2773     // List of items/objects that can appear in a 'copyin' clause must be
2774     // 'threadprivate'
2775     if (!IsSymbolThreadprivate(symbol)) {
2776       context_.Say(name.source,
2777           "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
2778           symbol.name());
2779     }
2780   } else if (ompFlag == Symbol::Flag::OmpCopyPrivate &&
2781       GetContext().directive == llvm::omp::Directive::OMPD_single) {
2782     // A list item that appears in a 'copyprivate' clause may not appear on a
2783     // 'private' or 'firstprivate' clause on a single construct
2784     if (IsObjectWithDSA(symbol) &&
2785         (symbol.test(Symbol::Flag::OmpPrivate) ||
2786             symbol.test(Symbol::Flag::OmpFirstPrivate))) {
2787       context_.Say(name.source,
2788           "COPYPRIVATE variable '%s' may not appear on a PRIVATE or "
2789           "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US,
2790           symbol.name());
2791     } else if (!IsSymbolThreadprivate(symbol) && !IsSymbolPrivate(symbol)) {
2792       // List of items/objects that can appear in a 'copyprivate' clause must be
2793       // either 'private' or 'threadprivate' in enclosing context.
2794       context_.Say(name.source,
2795           "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "
2796           "outer context"_err_en_US,
2797           symbol.name());
2798     }
2799   }
2800 }
2801
2802 void OmpAttributeVisitor::CheckObjectIsPrivatizable(
2803     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
2804   const auto &ultimateSymbol{symbol.GetUltimate()};
2805   llvm::StringRef clauseName{"PRIVATE"};
2806   if (ompFlag == Symbol::Flag::OmpFirstPrivate) {
2807     clauseName = "FIRSTPRIVATE";
2808   } else if (ompFlag == Symbol::Flag::OmpLastPrivate) {
2809     clauseName = "LASTPRIVATE";
2810   }
2811
2812   if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
2813     context_.Say(name.source,
2814         "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
2815         name.ToString(), clauseName.str());
2816   }
2817
2818   if (ultimateSymbol.has<AssocEntityDetails>()) {
2819     context_.Say(name.source,
2820         "Variable '%s' in ASSOCIATE cannot be in a %s clause"_err_en_US,
2821         name.ToString(), clauseName.str());
2822   }
2823
2824   if (stmtFunctionExprSymbols_.find(ultimateSymbol) !=
2825       stmtFunctionExprSymbols_.end()) {
2826     context_.Say(name.source,
2827         "Variable '%s' in statement function expression cannot be in a "
2828         "%s clause"_err_en_US,
2829         name.ToString(), clauseName.str());
2830   }
2831 }
2832
2833 void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) {
2834   // Get the context to check if the statement causing a jump to the 'label' is
2835   // in an enclosing OpenMP construct
2836   std::optional<DirContext> thisContext{GetContextIf()};
2837   sourceLabels_.emplace(
2838       label, std::make_pair(currentStatementSource_, thisContext));
2839   // Check if the statement with 'label' to which a jump is being introduced
2840   // has already been encountered
2841   auto it{targetLabels_.find(label)};
2842   if (it != targetLabels_.end()) {
2843     // Check if both the statement with 'label' and the statement that causes a
2844     // jump to the 'label' are in the same scope
2845     CheckLabelContext(currentStatementSource_, it->second.first, thisContext,
2846         it->second.second);
2847   }
2848 }
2849
2850 // Check for invalid branch into or out of OpenMP structured blocks
2851 void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source,
2852     const parser::CharBlock target, std::optional<DirContext> sourceContext,
2853     std::optional<DirContext> targetContext) {
2854   if (targetContext &&
2855       (!sourceContext ||
2856           (sourceContext->scope != targetContext->scope &&
2857               !DoesScopeContain(
2858                   &targetContext->scope, sourceContext->scope)))) {
2859     context_
2860         .Say(source, "invalid branch into an OpenMP structured block"_err_en_US)
2861         .Attach(target, "In the enclosing %s directive branched into"_en_US,
2862             parser::ToUpperCaseLetters(
2863                 llvm::omp::getOpenMPDirectiveName(targetContext->directive)
2864                     .str()));
2865   }
2866   if (sourceContext &&
2867       (!targetContext ||
2868           (sourceContext->scope != targetContext->scope &&
2869               !DoesScopeContain(
2870                   &sourceContext->scope, targetContext->scope)))) {
2871     context_
2872         .Say(source,
2873             "invalid branch leaving an OpenMP structured block"_err_en_US)
2874         .Attach(target, "Outside the enclosing %s directive"_en_US,
2875             parser::ToUpperCaseLetters(
2876                 llvm::omp::getOpenMPDirectiveName(sourceContext->directive)
2877                     .str()));
2878   }
2879 }
2880
2881 // Goes through the names in an OmpObjectList and checks if each name appears
2882 // in the given allocate statement
2883 void OmpAttributeVisitor::CheckAllNamesInAllocateStmt(
2884     const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList,
2885     const parser::AllocateStmt &allocate) {
2886   for (const auto &obj : ompObjectList.v) {
2887     if (const auto *d{std::get_if<parser::Designator>(&obj.u)}) {
2888       if (const auto *ref{std::get_if<parser::DataRef>(&d->u)}) {
2889         if (const auto *n{std::get_if<parser::Name>(&ref->u)}) {
2890           CheckNameInAllocateStmt(source, *n, allocate);
2891         }
2892       }
2893     }
2894   }
2895 }
2896
2897 void OmpAttributeVisitor::CheckNameInAllocateStmt(
2898     const parser::CharBlock &source, const parser::Name &name,
2899     const parser::AllocateStmt &allocate) {
2900   for (const auto &allocation :
2901       std::get<std::list<parser::Allocation>>(allocate.t)) {
2902     const auto &allocObj = std::get<parser::AllocateObject>(allocation.t);
2903     if (const auto *n{std::get_if<parser::Name>(&allocObj.u)}) {
2904       if (n->source == name.source) {
2905         return;
2906       }
2907     }
2908   }
2909   context_.Say(source,
2910       "Object '%s' in %s directive not "
2911       "found in corresponding ALLOCATE statement"_err_en_US,
2912       name.ToString(),
2913       parser::ToUpperCaseLetters(
2914           llvm::omp::getOpenMPDirectiveName(GetContext().directive).str()));
2915 }
2916
2917 void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope,
2918     WithOmpDeclarative::RequiresFlags flags,
2919     std::optional<common::OmpAtomicDefaultMemOrderType> memOrder) {
2920   Scope *scopeIter = &scope;
2921   do {
2922     if (Symbol * symbol{scopeIter->symbol()}) {
2923       common::visit(
2924           [&](auto &details) {
2925             // Store clauses information into the symbol for the parent and
2926             // enclosing modules, programs, functions and subroutines.
2927             if constexpr (std::is_convertible_v<decltype(&details),
2928                               WithOmpDeclarative *>) {
2929               if (flags.any()) {
2930                 if (const WithOmpDeclarative::RequiresFlags *
2931                     otherFlags{details.ompRequires()}) {
2932                   flags |= *otherFlags;
2933                 }
2934                 details.set_ompRequires(flags);
2935               }
2936               if (memOrder) {
2937                 if (details.has_ompAtomicDefaultMemOrder() &&
2938                     *details.ompAtomicDefaultMemOrder() != *memOrder) {
2939                   context_.Say(scopeIter->sourceRange(),
2940                       "Conflicting '%s' REQUIRES clauses found in compilation "
2941                       "unit"_err_en_US,
2942                       parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
2943                           llvm::omp::Clause::OMPC_atomic_default_mem_order)
2944                                                      .str()));
2945                 }
2946                 details.set_ompAtomicDefaultMemOrder(*memOrder);
2947               }
2948             }
2949           },
2950           symbol->details());
2951     }
2952     scopeIter = &scopeIter->parent();
2953   } while (!scopeIter->IsGlobal());
2954 }
2955
2956 void OmpAttributeVisitor::IssueNonConformanceWarning(
2957     llvm::omp::Directive D, parser::CharBlock source) {
2958   std::string warnStr;
2959   llvm::raw_string_ostream warnStrOS(warnStr);
2960   warnStrOS << "OpenMP directive "
2961             << parser::ToUpperCaseLetters(
2962                    llvm::omp::getOpenMPDirectiveName(D).str())
2963             << " has been deprecated";
2964
2965   auto setAlternativeStr = [&warnStrOS](llvm::StringRef alt) {
2966     warnStrOS << ", please use " << alt << " instead.";
2967   };
2968   switch (D) {
2969   case llvm::omp::OMPD_master:
2970     setAlternativeStr("MASKED");
2971     break;
2972   case llvm::omp::OMPD_master_taskloop:
2973     setAlternativeStr("MASKED TASKLOOP");
2974     break;
2975   case llvm::omp::OMPD_master_taskloop_simd:
2976     setAlternativeStr("MASKED TASKLOOP SIMD");
2977     break;
2978   case llvm::omp::OMPD_parallel_master:
2979     setAlternativeStr("PARALLEL MASKED");
2980     break;
2981   case llvm::omp::OMPD_parallel_master_taskloop:
2982     setAlternativeStr("PARALLEL MASKED TASKLOOP");
2983     break;
2984   case llvm::omp::OMPD_parallel_master_taskloop_simd:
2985     setAlternativeStr("PARALLEL_MASKED TASKLOOP SIMD");
2986     break;
2987   case llvm::omp::OMPD_target_loop:
2988   default:;
2989   }
2990   context_.Warn(common::UsageWarning::OpenMPUsage, source, "%s"_warn_en_US,
2991       warnStrOS.str());
2992 }
2993 } // namespace Fortran::semantics