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