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::AccReductionOperator::Operator,
26 Fortran::parser::AccReductionOperator::Operator_enumSize>;
27
28static ReductionOpsSet reductionIntegerSet{
29 Fortran::parser::AccReductionOperator::Operator::Plus,
30 Fortran::parser::AccReductionOperator::Operator::Multiply,
31 Fortran::parser::AccReductionOperator::Operator::Max,
32 Fortran::parser::AccReductionOperator::Operator::Min,
33 Fortran::parser::AccReductionOperator::Operator::Iand,
34 Fortran::parser::AccReductionOperator::Operator::Ior,
35 Fortran::parser::AccReductionOperator::Operator::Ieor};
36
37static ReductionOpsSet reductionRealSet{
38 Fortran::parser::AccReductionOperator::Operator::Plus,
39 Fortran::parser::AccReductionOperator::Operator::Multiply,
40 Fortran::parser::AccReductionOperator::Operator::Max,
41 Fortran::parser::AccReductionOperator::Operator::Min};
42
43static ReductionOpsSet reductionComplexSet{
44 Fortran::parser::AccReductionOperator::Operator::Plus,
45 Fortran::parser::AccReductionOperator::Operator::Multiply};
46
47static ReductionOpsSet reductionLogicalSet{
48 Fortran::parser::AccReductionOperator::Operator::And,
49 Fortran::parser::AccReductionOperator::Operator::Or,
50 Fortran::parser::AccReductionOperator::Operator::Eqv,
51 Fortran::parser::AccReductionOperator::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(Async, ACCC_async)
378CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
379CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
380CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)
381CHECK_SIMPLE_CLAUSE(Default, ACCC_default)
382CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)
383CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)
384CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)
385CHECK_SIMPLE_CLAUSE(Device, ACCC_device)
386CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)
387CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)
388CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)
389CHECK_SIMPLE_CLAUSE(Host, ACCC_host)
390CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)
391CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)
392CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)
393CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)
394CHECK_SIMPLE_CLAUSE(Private, ACCC_private)
395CHECK_SIMPLE_CLAUSE(Read, ACCC_read)
396CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device)
397CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait)
398CHECK_SIMPLE_CLAUSE(Write, ACCC_write)
399CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)
400
401void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
402 const parser::AccObjectList &list, llvm::acc::Clause clause) {
403 if (GetContext().directive != llvm::acc::Directive::ACCD_declare)
404 return;
405 for (const auto &object : list.v) {
406 std::visit(
407 Fortran::common::visitors{
408 [&](const Fortran::parser::Designator &designator) {
409 if (const auto *name = getDesignatorNameIfDataRef(designator)) {
410 if (declareSymbols.contains(&name->symbol->GetUltimate())) {
411 if (declareSymbols[&name->symbol->GetUltimate()] == clause) {
412 context_.Say(GetContext().clauseSource,
413 "'%s' in the %s clause is already present in the same "
414 "clause in this module"_warn_en_US,
415 name->symbol->name(),
416 parser::ToUpperCaseLetters(
417 llvm::acc::getOpenACCClauseName(clause).str()));
418 } else {
419 context_.Say(GetContext().clauseSource,
420 "'%s' in the %s clause is already present in another "
421 "%s clause in this module"_err_en_US,
422 name->symbol->name(),
423 parser::ToUpperCaseLetters(
424 llvm::acc::getOpenACCClauseName(clause).str()),
425 parser::ToUpperCaseLetters(
426 llvm::acc::getOpenACCClauseName(
427 declareSymbols[&name->symbol->GetUltimate()])
428 .str()));
429 }
430 }
431 declareSymbols.insert({&name->symbol->GetUltimate(), clause});
432 }
433 },
434 [&](const Fortran::parser::Name &name) {
435 // TODO: check common block
436 }},
437 object.u);
438 }
439}
440
441void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
442 const parser::AccObjectListWithModifier &list, llvm::acc::Clause clause) {
443 const auto &objectList = std::get<Fortran::parser::AccObjectList>(list.t);
444 CheckMultipleOccurrenceInDeclare(objectList, clause);
445}
446
447void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
448 CheckAllowed(llvm::acc::Clause::ACCC_create);
449 const auto &modifierClause{c.v};
450 if (const auto &modifier{
451 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
452 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
453 context_.Say(GetContext().clauseSource,
454 "Only the ZERO modifier is allowed for the %s clause "
455 "on the %s directive"_err_en_US,
456 parser::ToUpperCaseLetters(
457 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
458 .str()),
459 ContextDirectiveAsFortran());
460 }
461 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {
462 context_.Say(GetContext().clauseSource,
463 "The ZERO modifier is not allowed for the %s clause "
464 "on the %s directive"_err_en_US,
465 parser::ToUpperCaseLetters(
466 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
467 .str()),
468 ContextDirectiveAsFortran());
469 }
470 }
471 CheckMultipleOccurrenceInDeclare(
472 modifierClause, llvm::acc::Clause::ACCC_create);
473}
474
475void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
476 CheckAllowed(llvm::acc::Clause::ACCC_copyin);
477 const auto &modifierClause{c.v};
478 if (const auto &modifier{
479 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
480 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) {
481 return;
482 }
483 if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) {
484 context_.Say(GetContext().clauseSource,
485 "Only the READONLY modifier is allowed for the %s clause "
486 "on the %s directive"_err_en_US,
487 parser::ToUpperCaseLetters(
488 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin)
489 .str()),
490 ContextDirectiveAsFortran());
491 }
492 }
493 CheckMultipleOccurrenceInDeclare(
494 modifierClause, llvm::acc::Clause::ACCC_copyin);
495}
496
497void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
498 CheckAllowed(llvm::acc::Clause::ACCC_copyout);
499 const auto &modifierClause{c.v};
500 if (const auto &modifier{
501 std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
502 if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) {
503 return;
504 }
505 if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
506 context_.Say(GetContext().clauseSource,
507 "Only the ZERO modifier is allowed for the %s clause "
508 "on the %s directive"_err_en_US,
509 parser::ToUpperCaseLetters(
510 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
511 .str()),
512 ContextDirectiveAsFortran());
513 }
514 if (GetContext().directive == llvm::acc::Directive::ACCD_declare) {
515 context_.Say(GetContext().clauseSource,
516 "The ZERO modifier is not allowed for the %s clause "
517 "on the %s directive"_err_en_US,
518 parser::ToUpperCaseLetters(
519 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
520 .str()),
521 ContextDirectiveAsFortran());
522 }
523 }
524 CheckMultipleOccurrenceInDeclare(
525 modifierClause, llvm::acc::Clause::ACCC_copyout);
526}
527
528void AccStructureChecker::Enter(const parser::AccClause::DeviceType &d) {
529 CheckAllowed(llvm::acc::Clause::ACCC_device_type);
530 if (GetContext().directive == llvm::acc::Directive::ACCD_set &&
531 d.v.v.size() > 1) {
532 context_.Say(GetContext().clauseSource,
533 "The %s clause on the %s directive accepts only one value"_err_en_US,
534 parser::ToUpperCaseLetters(
535 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_device_type)
536 .str()),
537 ContextDirectiveAsFortran());
538 }
539 ResetCrtGroup();
540}
541
542void AccStructureChecker::Enter(const parser::AccClause::Seq &g) {
543 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_seq;
544 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
545 CheckMutuallyExclusivePerGroup(crtClause,
546 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
547 }
548 CheckAllowed(crtClause);
549}
550
551void AccStructureChecker::Enter(const parser::AccClause::Vector &g) {
552 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_vector;
553 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
554 CheckMutuallyExclusivePerGroup(crtClause,
555 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
556 }
557 CheckAllowed(crtClause);
558 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
559 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
560 }
561}
562
563void AccStructureChecker::Enter(const parser::AccClause::Worker &g) {
564 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_worker;
565 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
566 CheckMutuallyExclusivePerGroup(crtClause,
567 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
568 }
569 CheckAllowed(crtClause);
570 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
571 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
572 }
573}
574
575void AccStructureChecker::Enter(const parser::AccClause::Tile &g) {
576 CheckAllowed(llvm::acc::Clause::ACCC_tile);
577 CheckAllowedOncePerGroup(
578 llvm::acc::Clause::ACCC_tile, llvm::acc::Clause::ACCC_device_type);
579}
580
581void AccStructureChecker::Enter(const parser::AccClause::Gang &g) {
582 llvm::acc::Clause crtClause = llvm::acc::Clause::ACCC_gang;
583 if (GetContext().directive == llvm::acc::Directive::ACCD_routine) {
584 CheckMutuallyExclusivePerGroup(crtClause,
585 llvm::acc::Clause::ACCC_device_type, routineMutuallyExclusiveClauses);
586 }
587 CheckAllowed(crtClause);
588 if (GetContext().directive != llvm::acc::Directive::ACCD_routine) {
589 CheckAllowedOncePerGroup(crtClause, llvm::acc::Clause::ACCC_device_type);
590 }
591
592 if (g.v) {
593 bool hasNum = false;
594 bool hasDim = false;
595 bool hasStatic = false;
596 const Fortran::parser::AccGangArgList &x = *g.v;
597 for (const Fortran::parser::AccGangArg &gangArg : x.v) {
598 if (std::get_if<Fortran::parser::AccGangArg::Num>(&gangArg.u)) {
599 hasNum = true;
600 } else if (std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) {
601 hasDim = true;
602 } else if (std::get_if<Fortran::parser::AccGangArg::Static>(&gangArg.u)) {
603 hasStatic = true;
604 }
605 }
606
607 if (GetContext().directive == llvm::acc::Directive::ACCD_routine &&
608 (hasStatic || hasNum)) {
609 context_.Say(GetContext().clauseSource,
610 "Only the dim argument is allowed on the %s clause on the %s directive"_err_en_US,
611 parser::ToUpperCaseLetters(
612 llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_gang)
613 .str()),
614 ContextDirectiveAsFortran());
615 }
616
617 if (hasDim && hasNum) {
618 context_.Say(GetContext().clauseSource,
619 "The num argument is not allowed when dim is specified"_err_en_US);
620 }
621 }
622}
623
624void AccStructureChecker::Enter(const parser::AccClause::NumGangs &n) {
625 CheckAllowed(llvm::acc::Clause::ACCC_num_gangs,
626 /*warnInsteadOfError=*/GetContext().directive ==
627 llvm::acc::Directive::ACCD_serial ||
628 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
629 CheckAllowedOncePerGroup(
630 llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_device_type);
631
632 if (n.v.size() > 3)
633 context_.Say(GetContext().clauseSource,
634 "NUM_GANGS clause accepts a maximum of 3 arguments"_err_en_US);
635}
636
637void AccStructureChecker::Enter(const parser::AccClause::NumWorkers &n) {
638 CheckAllowed(llvm::acc::Clause::ACCC_num_workers,
639 /*warnInsteadOfError=*/GetContext().directive ==
640 llvm::acc::Directive::ACCD_serial ||
641 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
642 CheckAllowedOncePerGroup(
643 llvm::acc::Clause::ACCC_num_workers, llvm::acc::Clause::ACCC_device_type);
644}
645
646void AccStructureChecker::Enter(const parser::AccClause::VectorLength &n) {
647 CheckAllowed(llvm::acc::Clause::ACCC_vector_length,
648 /*warnInsteadOfError=*/GetContext().directive ==
649 llvm::acc::Directive::ACCD_serial ||
650 GetContext().directive == llvm::acc::Directive::ACCD_serial_loop);
651 CheckAllowedOncePerGroup(llvm::acc::Clause::ACCC_vector_length,
652 llvm::acc::Clause::ACCC_device_type);
653}
654
655void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) {
656 CheckAllowed(llvm::acc::Clause::ACCC_reduction);
657
658 // From OpenACC 3.3
659 // At a minimum, the supported data types include Fortran logical as well as
660 // the numerical data types (e.g. integer, real, double precision, complex).
661 // However, for each reduction operator, the supported data types include only
662 // the types permitted as operands to the corresponding operator in the base
663 // language where (1) for max and min, the corresponding operator is less-than
664 // and (2) for other operators, the operands and the result are the same type.
665 //
666 // The following check that the reduction operator is supported with the given
667 // type.
668 const parser::AccObjectListWithReduction &list{reduction.v};
669 const auto &op{std::get<parser::AccReductionOperator>(list.t)};
670 const auto &objects{std::get<parser::AccObjectList>(list.t)};
671
672 for (const auto &object : objects.v) {
673 std::visit(
674 Fortran::common::visitors{
675 [&](const Fortran::parser::Designator &designator) {
676 if (const auto *name = getDesignatorNameIfDataRef(designator)) {
677 const auto *type{name->symbol->GetType()};
678 if (type->IsNumeric(TypeCategory::Integer) &&
679 !reductionIntegerSet.test(op.v)) {
680 context_.Say(GetContext().clauseSource,
681 "reduction operator not supported for integer type"_err_en_US);
682 } else if (type->IsNumeric(TypeCategory::Real) &&
683 !reductionRealSet.test(op.v)) {
684 context_.Say(GetContext().clauseSource,
685 "reduction operator not supported for real type"_err_en_US);
686 } else if (type->IsNumeric(TypeCategory::Complex) &&
687 !reductionComplexSet.test(op.v)) {
688 context_.Say(GetContext().clauseSource,
689 "reduction operator not supported for complex type"_err_en_US);
690 } else if (type->category() ==
691 Fortran::semantics::DeclTypeSpec::Category::Logical &&
692 !reductionLogicalSet.test(op.v)) {
693 context_.Say(GetContext().clauseSource,
694 "reduction operator not supported for logical type"_err_en_US);
695 }
696 // TODO: check composite type.
697 }
698 },
699 [&](const Fortran::parser::Name &name) {
700 // TODO: check common block
701 }},
702 object.u);
703 }
704}
705
706void AccStructureChecker::Enter(const parser::AccClause::Self &x) {
707 CheckAllowed(llvm::acc::Clause::ACCC_self);
708 const std::optional<parser::AccSelfClause> &accSelfClause = x.v;
709 if (GetContext().directive == llvm::acc::Directive::ACCD_update &&
710 ((accSelfClause &&
711 std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>(
712 (*accSelfClause).u)) ||
713 !accSelfClause)) {
714 context_.Say(GetContext().clauseSource,
715 "SELF clause on the %s directive must have a var-list"_err_en_US,
716 ContextDirectiveAsFortran());
717 } else if (GetContext().directive != llvm::acc::Directive::ACCD_update &&
718 accSelfClause &&
719 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {
720 const auto &accObjectList =
721 std::get<parser::AccObjectList>((*accSelfClause).u);
722 if (accObjectList.v.size() != 1) {
723 context_.Say(GetContext().clauseSource,
724 "SELF clause on the %s directive only accepts optional scalar logical"
725 " expression"_err_en_US,
726 ContextDirectiveAsFortran());
727 }
728 }
729}
730
731void AccStructureChecker::Enter(const parser::AccClause::Collapse &x) {
732 CheckAllowed(llvm::acc::Clause::ACCC_collapse);
733 CheckAllowedOncePerGroup(
734 llvm::acc::Clause::ACCC_collapse, llvm::acc::Clause::ACCC_device_type);
735 const parser::AccCollapseArg &accCollapseArg = x.v;
736 const auto &collapseValue{
737 std::get<parser::ScalarIntConstantExpr>(accCollapseArg.t)};
738 RequiresConstantPositiveParameter(
739 llvm::acc::Clause::ACCC_collapse, collapseValue);
740}
741
742void AccStructureChecker::Enter(const parser::AccClause::Present &x) {
743 CheckAllowed(llvm::acc::Clause::ACCC_present);
744 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_present);
745}
746
747void AccStructureChecker::Enter(const parser::AccClause::Copy &x) {
748 CheckAllowed(llvm::acc::Clause::ACCC_copy);
749 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_copy);
750}
751
752void AccStructureChecker::Enter(const parser::AccClause::Deviceptr &x) {
753 CheckAllowed(llvm::acc::Clause::ACCC_deviceptr);
754 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_deviceptr);
755}
756
757void AccStructureChecker::Enter(const parser::AccClause::DeviceResident &x) {
758 CheckAllowed(llvm::acc::Clause::ACCC_device_resident);
759 CheckMultipleOccurrenceInDeclare(
760 x.v, llvm::acc::Clause::ACCC_device_resident);
761}
762
763void AccStructureChecker::Enter(const parser::AccClause::Link &x) {
764 CheckAllowed(llvm::acc::Clause::ACCC_link);
765 CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link);
766}
767
768void AccStructureChecker::Enter(const parser::AccClause::If &x) {
769 CheckAllowed(llvm::acc::Clause::ACCC_if);
770 if (const auto *expr{GetExpr(x.v)}) {
771 if (auto type{expr->GetType()}) {
772 if (type->category() == TypeCategory::Integer ||
773 type->category() == TypeCategory::Logical) {
774 return; // LOGICAL and INTEGER type supported for the if clause.
775 }
776 }
777 }
778 context_.Say(
779 GetContext().clauseSource, "Must have LOGICAL or INTEGER type"_err_en_US);
780}
781
782void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) {
783 context_.Say(x.source, "Misplaced OpenACC end directive"_warn_en_US);
784}
785
786void AccStructureChecker::Enter(const parser::Module &) {
787 declareSymbols.clear();
788}
789
790void AccStructureChecker::Enter(const parser::FunctionSubprogram &x) {
791 declareSymbols.clear();
792}
793
794void AccStructureChecker::Enter(const parser::SubroutineSubprogram &) {
795 declareSymbols.clear();
796}
797
798void AccStructureChecker::Enter(const parser::SeparateModuleSubprogram &) {
799 declareSymbols.clear();
800}
801
802void AccStructureChecker::Enter(const parser::DoConstruct &) {
803 ++loopNestLevel;
804}
805
806void AccStructureChecker::Leave(const parser::DoConstruct &) {
807 --loopNestLevel;
808}
809
810llvm::StringRef AccStructureChecker::getDirectiveName(
811 llvm::acc::Directive directive) {
812 return llvm::acc::getOpenACCDirectiveName(directive);
813}
814
815llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
816 return llvm::acc::getOpenACCClauseName(clause);
817}
818
819} // namespace Fortran::semantics
820

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