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

source code of flang/lib/Semantics/resolve-directives.cpp