1//===-- lib/Semantics/check-acc-structure.cpp -----------------------------===//
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#include "check-acc-structure.h"
9#include "flang/Common/enum-set.h"
10#include "flang/Parser/parse-tree.h"
11#include "flang/Semantics/tools.h"
12
13#define CHECK_SIMPLE_CLAUSE(X, Y) \
14 void AccStructureChecker::Enter(const parser::AccClause::X &) { \
15 CheckAllowed(llvm::acc::Clause::Y); \
16 }
17
18#define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \
19 void AccStructureChecker::Enter(const parser::AccClause::X &c) { \
20 CheckAllowed(llvm::acc::Clause::Y); \
21 RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \
22 }
23
24using ReductionOpsSet =
25 Fortran::common::EnumSet<Fortran::parser::ReductionOperator::Operator,
26 Fortran::parser::ReductionOperator::Operator_enumSize>;
27
28static ReductionOpsSet reductionIntegerSet{
29 Fortran::parser::ReductionOperator::Operator::Plus,
30 Fortran::parser::ReductionOperator::Operator::Multiply,
31 Fortran::parser::ReductionOperator::Operator::Max,
32 Fortran::parser::ReductionOperator::Operator::Min,
33 Fortran::parser::ReductionOperator::Operator::Iand,
34 Fortran::parser::ReductionOperator::Operator::Ior,
35 Fortran::parser::ReductionOperator::Operator::Ieor};
36
37static ReductionOpsSet reductionRealSet{
38 Fortran::parser::ReductionOperator::Operator::Plus,
39 Fortran::parser::ReductionOperator::Operator::Multiply,
40 Fortran::parser::ReductionOperator::Operator::Max,
41 Fortran::parser::ReductionOperator::Operator::Min};
42
43static ReductionOpsSet reductionComplexSet{
44 Fortran::parser::ReductionOperator::Operator::Plus,
45 Fortran::parser::ReductionOperator::Operator::Multiply};
46
47static ReductionOpsSet reductionLogicalSet{
48 Fortran::parser::ReductionOperator::Operator::And,
49 Fortran::parser::ReductionOperator::Operator::Or,
50 Fortran::parser::ReductionOperator::Operator::Eqv,
51 Fortran::parser::ReductionOperator::Operator::Neqv};
52
53namespace Fortran::semantics {
54
55static constexpr inline AccClauseSet
56 computeConstructOnlyAllowedAfterDeviceTypeClauses{
57 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait,
58 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers,
59 llvm::acc::Clause::ACCC_vector_length};
60
61static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{
62 llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse,
63 llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang,
64 llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile,
65 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};
66
67static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{
68 llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait};
69
70static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{
71 llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang,
72 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker,
73 llvm::acc::Clause::ACCC_seq};
74
75static constexpr inline AccClauseSet routineMutuallyExclusiveClauses{
76 llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_worker,
77 llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_seq};
78
79bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) {
80 if (GetContext().directive == llvm::acc::ACCD_enter_data ||
81 GetContext().directive == llvm::acc::ACCD_exit_data) {
82 context_.Say(GetContext().clauseSource,
83 "Modifier is not allowed for the %s clause "
84 "on the %s directive"_err_en_US,
85 parser::ToUpperCaseLetters(getClauseName(clause).str()),
86 ContextDirectiveAsFortran());
87 return true;
88 }
89 return false;
90}
91
92bool AccStructureChecker::IsComputeConstruct(
93 llvm::acc::Directive directive) const {
94 return directive == llvm::acc::ACCD_parallel ||
95 directive == llvm::acc::ACCD_parallel_loop ||
96 directive == llvm::acc::ACCD_serial ||
97 directive == llvm::acc::ACCD_serial_loop ||
98 directive == llvm::acc::ACCD_kernels ||
99 directive == llvm::acc::ACCD_kernels_loop;
100}
101
102bool AccStructureChecker::IsInsideComputeConstruct() const {
103 if (dirContext_.size() <= 1) {
104 return false;
105 }
106
107 // Check all nested context skipping the first one.
108 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
109 if (IsComputeConstruct(dirContext_[i - 1].directive)) {
110 return true;
111 }
112 }
113 return false;
114}
115
116void AccStructureChecker::CheckNotInComputeConstruct() {
117 if (IsInsideComputeConstruct()) {
118 context_.Say(GetContext().directiveSource,
119 "Directive %s may not be called within a compute region"_err_en_US,
120 ContextDirectiveAsFortran());
121 }
122}
123
124void AccStructureChecker::Enter(const parser::AccClause &x) {
125 SetContextClause(x);
126}
127
128void AccStructureChecker::Leave(const parser::AccClauseList &) {}
129
130void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) {
131 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
132 const auto &endBlockDir{std::get<parser::AccEndBlockDirective>(x.t)};
133 const auto &beginAccBlockDir{
134 std::get<parser::AccBlockDirective>(beginBlockDir.t)};
135
136 CheckMatching(beginAccBlockDir, endBlockDir.v);
137 PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v);
138}
139
140void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) {
141 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
142 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
143 const parser::Block &block{std::get<parser::Block>(x.t)};
144 switch (blockDir.v) {
145 case llvm::acc::Directive::ACCD_kernels:
146 case llvm::acc::Directive::ACCD_parallel:
147 case llvm::acc::Directive::ACCD_serial:
148 // Restriction - line 1004-1005
149 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
150 computeConstructOnlyAllowedAfterDeviceTypeClauses);
151 // Restriction - line 1001
152 CheckNoBranching(block, GetContext().directive, blockDir.source);
153 break;
154 case llvm::acc::Directive::ACCD_data:
155 // Restriction - 2.6.5 pt 1
156 // Only a warning is emitted here for portability reason.
157 CheckRequireAtLeastOneOf(/*warnInsteadOfError=*/true);
158 // Restriction is not formally in the specification but all compilers emit
159 // an error and it is likely to be omitted from the spec.
160 CheckNoBranching(block, GetContext().directive, blockDir.source);
161 break;
162 case llvm::acc::Directive::ACCD_host_data:
163 // Restriction - line 1746
164 CheckRequireAtLeastOneOf();
165 break;
166 default:
167 break;
168 }
169 dirContext_.pop_back();
170}
171
172void AccStructureChecker::Enter(
173 const parser::OpenACCStandaloneDeclarativeConstruct &x) {
174 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
175 PushContextAndClauseSets(declarativeDir.source, declarativeDir.v);
176}
177
178void AccStructureChecker::Leave(
179 const parser::OpenACCStandaloneDeclarativeConstruct &x) {
180 // Restriction - line 2409
181 CheckAtLeastOneClause();
182
183 // Restriction - line 2417-2418 - In a Fortran module declaration section,
184 // only create, copyin, device_resident, and link clauses are allowed.
185 const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
186 const auto &scope{context_.FindScope(declarativeDir.source)};
187 const Scope &containingScope{GetProgramUnitContaining(scope)};
188 if (containingScope.kind() == Scope::Kind::Module) {
189 for (auto cl : GetContext().actualClauses) {
190 if (cl != llvm::acc::Clause::ACCC_create &&
191 cl != llvm::acc::Clause::ACCC_copyin &&
192 cl != llvm::acc::Clause::ACCC_device_resident &&
193 cl != llvm::acc::Clause::ACCC_link) {
194 context_.Say(GetContext().directiveSource,
195 "%s clause is not allowed on the %s directive in module "
196 "declaration "
197 "section"_err_en_US,
198 parser::ToUpperCaseLetters(
199 llvm::acc::getOpenACCClauseName(cl).str()),
200 ContextDirectiveAsFortran());
201 }
202 }
203 }
204 dirContext_.pop_back();
205}
206
207void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) {
208 const auto &beginCombinedDir{
209 std::get<parser::AccBeginCombinedDirective>(x.t)};
210 const auto &combinedDir{
211 std::get<parser::AccCombinedDirective>(beginCombinedDir.t)};
212
213 // check matching, End directive is optional
214 if (const auto &endCombinedDir{
215 std::get<std::optional<parser::AccEndCombinedDirective>>(x.t)}) {
216 CheckMatching<parser::AccCombinedDirective>(combinedDir, endCombinedDir->v);
217 }
218
219 PushContextAndClauseSets(combinedDir.source, combinedDir.v);
220}
221
222void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) {
223 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
224 const auto &combinedDir{
225 std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
226 auto &doCons{std::get<std::optional<parser::DoConstruct>>(x.t)};
227 switch (combinedDir.v) {
228 case llvm::acc::Directive::ACCD_kernels_loop:
229 case llvm::acc::Directive::ACCD_parallel_loop:
230 case llvm::acc::Directive::ACCD_serial_loop:
231 // Restriction - line 1004-1005
232 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
233 computeConstructOnlyAllowedAfterDeviceTypeClauses |
234 loopOnlyAllowedAfterDeviceTypeClauses);
235 if (doCons) {
236 const parser::Block &block{std::get<parser::Block>(doCons->t)};
237 CheckNoBranching(block, GetContext().directive, beginBlockDir.source);
238 }
239 break;
240 default:
241 break;
242 }
243 dirContext_.pop_back();
244}
245
246void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {
247 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
248 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
249 PushContextAndClauseSets(loopDir.source, loopDir.v);
250}
251
252void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) {
253 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
254 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
255 if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
256 // Restriction - line 1818-1819
257 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
258 loopOnlyAllowedAfterDeviceTypeClauses);
259 // Restriction - line 1834
260 CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq,
261 {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector,
262 llvm::acc::Clause::ACCC_worker});
263 }
264 dirContext_.pop_back();
265}
266
267void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) {
268 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
269 PushContextAndClauseSets(standaloneDir.source, standaloneDir.v);
270}
271
272void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
273 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
274 switch (standaloneDir.v) {
275 case llvm::acc::Directive::ACCD_enter_data:
276 case llvm::acc::Directive::ACCD_exit_data:
277 // Restriction - line 1310-1311 (ENTER DATA)
278 // Restriction - line 1312-1313 (EXIT DATA)
279 CheckRequireAtLeastOneOf();
280 break;
281 case llvm::acc::Directive::ACCD_set:
282 // Restriction - line 2610
283 CheckRequireAtLeastOneOf();
284 // Restriction - line 2602
285 CheckNotInComputeConstruct();
286 break;
287 case llvm::acc::Directive::ACCD_update:
288 // Restriction - line 2636
289 CheckRequireAtLeastOneOf();
290 // Restriction - line 2669
291 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
292 updateOnlyAllowedAfterDeviceTypeClauses);
293 break;
294 case llvm::acc::Directive::ACCD_init:
295 case llvm::acc::Directive::ACCD_shutdown:
296 // Restriction - line 2525 (INIT)
297 // Restriction - line 2561 (SHUTDOWN)
298 CheckNotInComputeConstruct();
299 break;
300 default:
301 break;
302 }
303 dirContext_.pop_back();
304}
305
306void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) {
307 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine);
308 const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
309 if (!optName) {
310 const auto &verbatim{std::get<parser::Verbatim>(x.t)};
311 const auto &scope{context_.FindScope(verbatim.source)};
312 const Scope &containingScope{GetProgramUnitContaining(scope)};
313 if (containingScope.kind() == Scope::Kind::Module) {
314 context_.Say(GetContext().directiveSource,
315 "ROUTINE directive without name must appear within the specification "
316 "part of a subroutine or function definition, or within an interface "
317 "body for a subroutine or function in an interface block"_err_en_US);
318 }
319 }
320}
321void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) {
322 // Restriction - line 2790
323 CheckRequireAtLeastOneOf();
324 // Restriction - line 2788-2789
325 CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
326 routineOnlyAllowedAfterDeviceTypeClauses);
327 dirContext_.pop_back();
328}
329
330void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) {
331 const auto &verbatim{std::get<parser::Verbatim>(x.t)};
332 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_wait);
333}
334void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &x) {
335 dirContext_.pop_back();
336}
337
338void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) {
339 PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic);
340}
341void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
342 dirContext_.pop_back();
343}
344
345void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) {
346 const parser::AssignmentStmt &assignment{
347 std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
348 const auto &var{std::get<parser::Variable>(assignment.t)};
349 const auto &expr{std::get<parser::Expr>(assignment.t)};
350 const auto *rhs{GetExpr(context_, expr)};
351 const auto *lhs{GetExpr(context_, var)};
352 if (lhs && rhs) {
353 if (lhs->Rank() != 0)
354 context_.Say(expr.source,
355 "LHS of atomic update statement must be scalar"_err_en_US);
356 if (rhs->Rank() != 0)
357 context_.Say(var.GetSource(),
358 "RHS of atomic update statement must be scalar"_err_en_US);
359 }
360}
361
362void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {
363 const auto &verbatim = std::get<parser::Verbatim>(x.t);
364 PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);
365 SetContextDirectiveSource(verbatim.source);
366 if (loopNestLevel == 0) {
367 context_.Say(verbatim.source,
368 "The CACHE directive must be inside a loop"_err_en_US);
369 }
370}
371void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {
372 dirContext_.pop_back();
373}
374
375// Clause checkers
376CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto)
377CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
378CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
379CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)
380CHECK_SIMPLE_CLAUSE(Default, ACCC_default)
381CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)
382CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)
383CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)
384CHECK_SIMPLE_CLAUSE(Device, ACCC_device)
385CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)
386CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)
387CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)
388CHECK_SIMPLE_CLAUSE(Host, ACCC_host)
389CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)
390CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)
391CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)
392CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)
393CHECK_SIMPLE_CLAUSE(Private, ACCC_private)
394CHECK_SIMPLE_CLAUSE(Read, ACCC_read)
395CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device)
396CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait)
397CHECK_SIMPLE_CLAUSE(Write, ACCC_write)
398CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)
399
400void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
401 const parser::AccObjectList &list, llvm::acc::Clause clause) {
402 if (GetContext().directive != llvm::acc::Directive::ACCD_declare)
403 return;
404 for (const auto &object : list.v) {
405 common::visit(
406 common::visitors{
407 [&](const parser::Designator &designator) {
408 if (const auto *name = getDesignatorNameIfDataRef(designator)) {
409 if (declareSymbols.contains(&name->symbol->GetUltimate())) {
410 if (declareSymbols[&name->symbol->GetUltimate()] == clause) {
411 context_.Warn(common::UsageWarning::OpenAccUsage,
412 GetContext().clauseSource,
413 "'%s' in the %s clause is already present in the same clause in this module"_warn_en_US,
414 name->symbol->name(),
415 parser::ToUpperCaseLetters(
416 llvm::acc::getOpenACCClauseName(clause).str()));
417 } else {
418 context_.Say(GetContext().clauseSource,
419 "'%s' in the %s clause is already present in another "
420 "%s clause in this module"_err_en_US,
421 name->symbol->name(),
422 parser::ToUpperCaseLetters(
423 llvm::acc::getOpenACCClauseName(clause).str()),
424 parser::ToUpperCaseLetters(
425 llvm::acc::getOpenACCClauseName(
426 declareSymbols[&name->symbol->GetUltimate()])
427 .str()));
428 }
429 }
430 declareSymbols.insert({&name->symbol->GetUltimate(), clause});
431 }
432 },
433 [&](const parser::Name &name) {
434 // TODO: check common block
435 }},
436 object.u);
437 }
438}
439
440void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
441 const parser::AccObjectListWithModifier &list, llvm::acc::Clause clause) {
442 const auto &objectList = std::get<Fortran::parser::AccObjectList>(list.t);
443 CheckMultipleOccurrenceInDeclare(objectList, clause);
444}
445
446void AccStructureChecker::Enter(const parser::AccClause::Async &c) {
447 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_async;
448 CheckAllowed(crtClause);
449 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
450}
451
452void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
453 CheckAllowed(llvm::acc::Clause::ACCC_create);
454 const auto &modifierClause{c.v};
455 if (const auto &modifier{
456 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
457 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
458 context_.Say(GetContext().clauseSource,
459 "Only the ZERO modifier is allowed for the %s clause "
460 "on the %s directive"_err_en_US,
461 parser::ToUpperCaseLetters(
462 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
463 .str()),
464 ContextDirectiveAsFortran());
465 }
466 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {
467 context_.Say(GetContext().clauseSource,
468 "The ZERO modifier is not allowed for the %s clause "
469 "on the %s directive"_err_en_US,
470 parser::ToUpperCaseLetters(
471 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
472 .str()),
473 ContextDirectiveAsFortran());
474 }
475 }
476 CheckMultipleOccurrenceInDeclare(
477 modifierClause, llvm::acc::Clause::ACCC_create);
478}
479
480void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
481 CheckAllowed(llvm::acc::Clause::ACCC_copyin);
482 const auto &modifierClause{c.v};
483 if (const auto &modifier{
484 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
485 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) {
486 return;
487 }
488 if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) {
489 context_.Say(GetContext().clauseSource,
490 "Only the READONLY modifier is allowed for the %s clause "
491 "on the %s directive"_err_en_US,
492 parser::ToUpperCaseLetters(
493 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin)
494 .str()),
495 ContextDirectiveAsFortran());
496 }
497 }
498 CheckMultipleOccurrenceInDeclare(
499 modifierClause, llvm::acc::Clause::ACCC_copyin);
500}
501
502void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
503 CheckAllowed(llvm::acc::Clause::ACCC_copyout);
504 const auto &modifierClause{c.v};
505 if (const auto &modifier{
506 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
507 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) {
508 return;
509 }
510 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
511 context_.Say(GetContext().clauseSource,
512 "Only the ZERO modifier is allowed for the %s clause "
513 "on the %s directive"_err_en_US,
514 parser::ToUpperCaseLetters(
515 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
516 .str()),
517 ContextDirectiveAsFortran());
518 }
519 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {
520 context_.Say(GetContext().clauseSource,
521 "The ZERO modifier is not allowed for the %s clause "
522 "on the %s directive"_err_en_US,
523 parser::ToUpperCaseLetters(
524 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
525 .str()),
526 ContextDirectiveAsFortran());
527 }
528 }
529 CheckMultipleOccurrenceInDeclare(
530 modifierClause, llvm::acc::Clause::ACCC_copyout);
531}
532
533void AccStructureChecker::Enter(const parser::AccClause::DeviceType &d) {
534 CheckAllowed(llvm::acc::Clause::ACCC_device_type);
535 if (GetContext().directive == llvm::acc::Directive::ACCD_set &&
536 d.v.v.size() > 1) {
537 context_.Say(GetContext().clauseSource,
538 "The %s clause on the %s directive accepts only one value"_err_en_US,
539 parser::ToUpperCaseLetters(
540 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_device_type)
541 .str()),
542 ContextDirectiveAsFortran());
543 }
544 ResetCrtGroup();
545}
546
547void AccStructureChecker::Enter(const parser::AccClause::Seq &g) {
548 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_seq;
549 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
550 CheckMutuallyExclusivePerGroup(crtClause,
551 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
552 }
553 CheckAllowed(crtClause);
554}
555
556void AccStructureChecker::Enter(const parser::AccClause::Vector &g) {
557 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_vector;
558 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
559 CheckMutuallyExclusivePerGroup(crtClause,
560 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
561 }
562 CheckAllowed(crtClause);
563 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
564 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
565 }
566}
567
568void AccStructureChecker::Enter(const parser::AccClause::Worker &g) {
569 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_worker;
570 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
571 CheckMutuallyExclusivePerGroup(crtClause,
572 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
573 }
574 CheckAllowed(crtClause);
575 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
576 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
577 }
578}
579
580void AccStructureChecker::Enter(const parser::AccClause::Tile &g) {
581 CheckAllowed(llvm::acc::Clause::ACCC_tile);
582 CheckAllowedOncePerGroup(
583 llvm::acc::Clause::ACCC_tile, llvm::acc::Clause::ACCC_device_type);
584}
585
586void AccStructureChecker::Enter(const parser::AccClause::Gang &g) {
587 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_gang;
588 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
589 CheckMutuallyExclusivePerGroup(crtClause,
590 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
591 }
592 CheckAllowed(crtClause);
593 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
594 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
595 }
596
597 if (g.v) {
598 bool hasNum = false;
599 bool hasDim = false;
600 bool hasStatic = false;
601 const Fortran::parser::AccGangArgList &x = *g.v;
602 for (const Fortran::parser::AccGangArg &gangArg : x.v) {
603 if (std::get_if<Fortran::parser::AccGangArg::Num>(&gangArg.u)) {
604 hasNum = true;
605 } else if (std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) {
606 hasDim = true;
607 } else if (std::get_if<Fortran::parser::AccGangArg::Static>(&gangArg.u)) {
608 hasStatic = true;
609 }
610 }
611
612 if (GetContext().directive == llvm::acc::Directive::ACCD_routine &&
613 (hasStatic || hasNum)) {
614 context_.Say(GetContext().clauseSource,
615 "Only the dim argument is allowed on the %s clause on the %s directive"_err_en_US,
616 parser::ToUpperCaseLetters(
617 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_gang)
618 .str()),
619 ContextDirectiveAsFortran());
620 }
621
622 if (hasDim && hasNum) {
623 context_.Say(GetContext().clauseSource,
624 "The num argument is not allowed when dim is specified"_err_en_US);
625 }
626 }
627}
628
629void AccStructureChecker::Enter(const parser::AccClause::NumGangs &n) {
630 CheckAllowed(llvm::acc::Clause::ACCC_num_gangs,
631 /*warnInsteadOfError=*/GetContext().directive ==
632 llvm::acc::Directive::ACCD_serial ||
633 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
634 CheckAllowedOncePerGroup(
635 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_device_type);
636
637 if (n.v.size() > 3)
638 context_.Say(GetContext().clauseSource,
639 "NUM_GANGS clause accepts a maximum of 3 arguments"_err_en_US);
640}
641
642void AccStructureChecker::Enter(const parser::AccClause::NumWorkers &n) {
643 CheckAllowed(llvm::acc::Clause::ACCC_num_workers,
644 /*warnInsteadOfError=*/GetContext().directive ==
645 llvm::acc::Directive::ACCD_serial ||
646 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
647 CheckAllowedOncePerGroup(
648 llvm::acc::Clause::ACCC_num_workers, llvm::acc::Clause::ACCC_device_type);
649}
650
651void AccStructureChecker::Enter(const parser::AccClause::VectorLength &n) {
652 CheckAllowed(llvm::acc::Clause::ACCC_vector_length,
653 /*warnInsteadOfError=*/GetContext().directive ==
654 llvm::acc::Directive::ACCD_serial ||
655 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
656 CheckAllowedOncePerGroup(llvm::acc::Clause::ACCC_vector_length,
657 llvm::acc::Clause::ACCC_device_type);
658}
659
660void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) {
661 CheckAllowed(llvm::acc::Clause::ACCC_reduction);
662
663 // From OpenACC 3.3
664 // At a minimum, the supported data types include Fortran logical as well as
665 // the numerical data types (e.g. integer, real, double precision, complex).
666 // However, for each reduction operator, the supported data types include only
667 // the types permitted as operands to the corresponding operator in the base
668 // language where (1) for max and min, the corresponding operator is less-than
669 // and (2) for other operators, the operands and the result are the same type.
670 //
671 // The following check that the reduction operator is supported with the given
672 // type.
673 const parser::AccObjectListWithReduction &list{reduction.v};
674 const auto &op{std::get<parser::ReductionOperator>(list.t)};
675 const auto &objects{std::get<parser::AccObjectList>(list.t)};
676
677 for (const auto &object : objects.v) {
678 common::visit(
679 common::visitors{
680 [&](const parser::Designator &designator) {
681 if (const auto *name = getDesignatorNameIfDataRef(designator)) {
682 if (name->symbol) {
683 const auto *type{name->symbol->GetType()};
684 if (type->IsNumeric(TypeCategory::Integer) &&
685 !reductionIntegerSet.test(op.v)) {
686 context_.Say(GetContext().clauseSource,
687 "reduction operator not supported for integer type"_err_en_US);
688 } else if (type->IsNumeric(TypeCategory::Real) &&
689 !reductionRealSet.test(op.v)) {
690 context_.Say(GetContext().clauseSource,
691 "reduction operator not supported for real type"_err_en_US);
692 } else if (type->IsNumeric(TypeCategory::Complex) &&
693 !reductionComplexSet.test(op.v)) {
694 context_.Say(GetContext().clauseSource,
695 "reduction operator not supported for complex type"_err_en_US);
696 } else if (type->category() ==
697 Fortran::semantics::DeclTypeSpec::Category::Logical &&
698 !reductionLogicalSet.test(op.v)) {
699 context_.Say(GetContext().clauseSource,
700 "reduction operator not supported for logical type"_err_en_US);
701 }
702 // TODO: check composite type.
703 }
704 }
705 },
706 [&](const Fortran::parser::Name &name) {
707 // TODO: check common block
708 }},
709 object.u);
710 }
711}
712
713void AccStructureChecker::Enter(const parser::AccClause::Self &x) {
714 CheckAllowed(llvm::acc::Clause::ACCC_self);
715 const std::optional<parser::AccSelfClause> &accSelfClause = x.v;
716 if (GetContext().directive == llvm::acc::Directive::ACCD_update &&
717 ((accSelfClause &&
718 std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>(
719 (*accSelfClause).u)) ||
720 !accSelfClause)) {
721 context_.Say(GetContext().clauseSource,
722 "SELF clause on the %s directive must have a var-list"_err_en_US,
723 ContextDirectiveAsFortran());
724 } else if (GetContext().directive != llvm::acc::Directive::ACCD_update &&
725 accSelfClause &&
726 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {
727 const auto &accObjectList =
728 std::get<parser::AccObjectList>((*accSelfClause).u);
729 if (accObjectList.v.size() != 1) {
730 context_.Say(GetContext().clauseSource,
731 "SELF clause on the %s directive only accepts optional scalar logical"
732 " expression"_err_en_US,
733 ContextDirectiveAsFortran());
734 }
735 }
736}
737
738void AccStructureChecker::Enter(const parser::AccClause::Collapse &x) {
739 CheckAllowed(llvm::acc::Clause::ACCC_collapse);
740 CheckAllowedOncePerGroup(
741 llvm::acc::Clause::ACCC_collapse, llvm::acc::Clause::ACCC_device_type);
742 const parser::AccCollapseArg &accCollapseArg = x.v;
743 const auto &collapseValue{
744 std::get<parser::ScalarIntConstantExpr>(accCollapseArg.t)};
745 RequiresConstantPositiveParameter(
746 llvm::acc::Clause::ACCC_collapse, collapseValue);
747}
748
749void AccStructureChecker::Enter(const parser::AccClause::Present &x) {
750 CheckAllowed(llvm::acc::Clause::ACCC_present);
751 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_present);
752}
753
754void AccStructureChecker::Enter(const parser::AccClause::Copy &x) {
755 CheckAllowed(llvm::acc::Clause::ACCC_copy);
756 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_copy);
757}
758
759void AccStructureChecker::Enter(const parser::AccClause::Deviceptr &x) {
760 CheckAllowed(llvm::acc::Clause::ACCC_deviceptr);
761 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_deviceptr);
762}
763
764void AccStructureChecker::Enter(const parser::AccClause::DeviceResident &x) {
765 CheckAllowed(llvm::acc::Clause::ACCC_device_resident);
766 CheckMultipleOccurrenceInDeclare(
767 x.v, llvm::acc::Clause::ACCC_device_resident);
768}
769
770void AccStructureChecker::Enter(const parser::AccClause::Link &x) {
771 CheckAllowed(llvm::acc::Clause::ACCC_link);
772 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link);
773}
774
775void AccStructureChecker::Enter(const parser::AccClause::Shortloop &x) {
776 if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop)) {
777 context_.Warn(common::UsageWarning::OpenAccUsage, GetContext().clauseSource,
778 "Non-standard shortloop clause ignored"_warn_en_US);
779 }
780}
781
782void AccStructureChecker::Enter(const parser::AccClause::If &x) {
783 CheckAllowed(llvm::acc::Clause::ACCC_if);
784 if (const auto *expr{GetExpr(x.v)}) {
785 if (auto type{expr->GetType()}) {
786 if (type->category() == TypeCategory::Integer ||
787 type->category() == TypeCategory::Logical) {
788 return; // LOGICAL and INTEGER type supported for the if clause.
789 }
790 }
791 }
792 context_.Say(
793 GetContext().clauseSource, "Must have LOGICAL or INTEGER type"_err_en_US);
794}
795
796void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) {
797 context_.Warn(common::UsageWarning::OpenAccUsage, x.source,
798 "Misplaced OpenACC end directive"_warn_en_US);
799}
800
801void AccStructureChecker::Enter(const parser::Module &) {
802 declareSymbols.clear();
803}
804
805void AccStructureChecker::Enter(const parser::FunctionSubprogram &x) {
806 declareSymbols.clear();
807}
808
809void AccStructureChecker::Enter(const parser::SubroutineSubprogram &) {
810 declareSymbols.clear();
811}
812
813void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) {
814 declareSymbols.clear();
815}
816
817void AccStructureChecker::Enter(const parser::DoConstruct &) {
818 ++loopNestLevel;
819}
820
821void AccStructureChecker::Leave(const parser::DoConstruct &) {
822 --loopNestLevel;
823}
824
825llvm::StringRef AccStructureChecker::getDirectiveName(
826 llvm::acc::Directive directive) {
827 return llvm::acc::getOpenACCDirectiveName(directive);
828}
829
830llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
831 return llvm::acc::getOpenACCClauseName(clause);
832}
833
834} // namespace Fortran::semantics
835

source code of flang/lib/Semantics/check-acc-structure.cpp