1 //===-- lib/Semantics/check-omp-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
9 #include "check-omp-structure.h"
10 #include "flang/Parser/parse-tree.h"
11 #include "flang/Semantics/tools.h"
12 #include <algorithm>
13
14 namespace Fortran::semantics {
15
16 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
17 #define CHECK_SIMPLE_CLAUSE(X, Y) \
18 void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
19 CheckAllowed(llvm::omp::Clause::Y); \
20 }
21
22 #define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
23 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
24 CheckAllowed(llvm::omp::Clause::Y); \
25 RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
26 }
27
28 #define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
29 void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
30 CheckAllowed(llvm::omp::Clause::Y); \
31 RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
32 }
33
34 // Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
35 #define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
36 void OmpStructureChecker::Enter(const parser::X &) { \
37 CheckAllowed(llvm::omp::Y); \
38 }
39
HasInvalidWorksharingNesting(const parser::CharBlock & source,const OmpDirectiveSet & set)40 bool OmpStructureChecker::HasInvalidWorksharingNesting(
41 const parser::CharBlock &source, const OmpDirectiveSet &set) {
42 // set contains all the invalid closely nested directives
43 // for the given directive (`source` here)
44 if (CurrentDirectiveIsNested() && set.test(GetContext().directive)) {
45 context_.Say(source,
46 "A worksharing region may not be closely nested inside a "
47 "worksharing, explicit task, taskloop, critical, ordered, atomic, or "
48 "master region"_err_en_US);
49 return true;
50 }
51 return false;
52 }
53
Enter(const parser::OpenMPConstruct &)54 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &) {
55 // 2.8.1 TODO: Simd Construct with Ordered Construct Nesting check
56 }
57
Enter(const parser::OpenMPLoopConstruct & x)58 void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
59 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
60 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
61
62 // check matching, End directive is optional
63 if (const auto &endLoopDir{
64 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
65 const auto &endDir{
66 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
67
68 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
69 }
70
71 if (beginDir.v != llvm::omp::Directive::OMPD_do) {
72 PushContextAndClauseSets(beginDir.source, beginDir.v);
73 } else {
74 // 2.7.1 do-clause -> private-clause |
75 // firstprivate-clause |
76 // lastprivate-clause |
77 // linear-clause |
78 // reduction-clause |
79 // schedule-clause |
80 // collapse-clause |
81 // ordered-clause
82
83 // nesting check
84 HasInvalidWorksharingNesting(beginDir.source,
85 {llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_sections,
86 llvm::omp::Directive::OMPD_single,
87 llvm::omp::Directive::OMPD_workshare,
88 llvm::omp::Directive::OMPD_task,
89 llvm::omp::Directive::OMPD_taskloop,
90 llvm::omp::Directive::OMPD_critical,
91 llvm::omp::Directive::OMPD_ordered,
92 llvm::omp::Directive::OMPD_atomic,
93 llvm::omp::Directive::OMPD_master});
94 PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do);
95 }
96 }
97
Leave(const parser::OpenMPLoopConstruct &)98 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
99 dirContext_.pop_back();
100 }
101
Enter(const parser::OmpEndLoopDirective & x)102 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
103 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
104 ResetPartialContext(dir.source);
105 switch (dir.v) {
106 // 2.7.1 end-do -> END DO [nowait-clause]
107 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
108 case llvm::omp::Directive::OMPD_do:
109 case llvm::omp::Directive::OMPD_do_simd:
110 SetClauseSets(dir.v);
111 break;
112 default:
113 // no clauses are allowed
114 break;
115 }
116 }
117
Enter(const parser::OpenMPBlockConstruct & x)118 void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
119 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
120 const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
121 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
122 const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
123 const parser::Block &block{std::get<parser::Block>(x.t)};
124
125 CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
126
127 PushContextAndClauseSets(beginDir.source, beginDir.v);
128
129 switch (beginDir.v) {
130 case llvm::omp::OMPD_parallel:
131 CheckNoBranching(block, llvm::omp::OMPD_parallel, beginDir.source);
132 break;
133 default:
134 break;
135 }
136 }
137
Leave(const parser::OpenMPBlockConstruct &)138 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
139 dirContext_.pop_back();
140 }
141
Enter(const parser::OpenMPSectionsConstruct & x)142 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
143 const auto &beginSectionsDir{
144 std::get<parser::OmpBeginSectionsDirective>(x.t)};
145 const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
146 const auto &beginDir{
147 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
148 const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
149 CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
150
151 PushContextAndClauseSets(beginDir.source, beginDir.v);
152 }
153
Leave(const parser::OpenMPSectionsConstruct &)154 void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
155 dirContext_.pop_back();
156 }
157
Enter(const parser::OmpEndSectionsDirective & x)158 void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
159 const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
160 ResetPartialContext(dir.source);
161 switch (dir.v) {
162 // 2.7.2 end-sections -> END SECTIONS [nowait-clause]
163 case llvm::omp::Directive::OMPD_sections:
164 PushContextAndClauseSets(
165 dir.source, llvm::omp::Directive::OMPD_end_sections);
166 break;
167 default:
168 // no clauses are allowed
169 break;
170 }
171 }
172
Enter(const parser::OpenMPDeclareSimdConstruct & x)173 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
174 const auto &dir{std::get<parser::Verbatim>(x.t)};
175 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
176 }
177
Leave(const parser::OpenMPDeclareSimdConstruct &)178 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
179 dirContext_.pop_back();
180 }
181
Enter(const parser::OpenMPDeclareTargetConstruct & x)182 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
183 const auto &dir{std::get<parser::Verbatim>(x.t)};
184 PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
185 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
186 if (std::holds_alternative<parser::OmpDeclareTargetWithClause>(spec.u)) {
187 SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
188 }
189 }
190
Leave(const parser::OpenMPDeclareTargetConstruct &)191 void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &) {
192 dirContext_.pop_back();
193 }
194
Enter(const parser::OpenMPSimpleStandaloneConstruct & x)195 void OmpStructureChecker::Enter(
196 const parser::OpenMPSimpleStandaloneConstruct &x) {
197 const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
198 PushContextAndClauseSets(dir.source, dir.v);
199 }
200
Leave(const parser::OpenMPSimpleStandaloneConstruct &)201 void OmpStructureChecker::Leave(
202 const parser::OpenMPSimpleStandaloneConstruct &) {
203 dirContext_.pop_back();
204 }
205
Enter(const parser::OpenMPFlushConstruct & x)206 void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
207 const auto &dir{std::get<parser::Verbatim>(x.t)};
208 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
209 }
210
Leave(const parser::OpenMPFlushConstruct &)211 void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &) {
212 dirContext_.pop_back();
213 }
214
Enter(const parser::OpenMPCancelConstruct & x)215 void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
216 const auto &dir{std::get<parser::Verbatim>(x.t)};
217 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
218 }
219
Leave(const parser::OpenMPCancelConstruct &)220 void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
221 dirContext_.pop_back();
222 }
223
Enter(const parser::OpenMPCriticalConstruct & x)224 void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
225 const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
226 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
227 }
228
Leave(const parser::OpenMPCriticalConstruct &)229 void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
230 dirContext_.pop_back();
231 }
232
Enter(const parser::OpenMPCancellationPointConstruct & x)233 void OmpStructureChecker::Enter(
234 const parser::OpenMPCancellationPointConstruct &x) {
235 const auto &dir{std::get<parser::Verbatim>(x.t)};
236 PushContextAndClauseSets(
237 dir.source, llvm::omp::Directive::OMPD_cancellation_point);
238 }
239
Leave(const parser::OpenMPCancellationPointConstruct &)240 void OmpStructureChecker::Leave(
241 const parser::OpenMPCancellationPointConstruct &) {
242 dirContext_.pop_back();
243 }
244
Enter(const parser::OmpEndBlockDirective & x)245 void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
246 const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
247 ResetPartialContext(dir.source);
248 switch (dir.v) {
249 // 2.7.3 end-single-clause -> copyprivate-clause |
250 // nowait-clause
251 case llvm::omp::Directive::OMPD_single:
252 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
253 break;
254 // 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
255 case llvm::omp::Directive::OMPD_workshare:
256 PushContextAndClauseSets(
257 dir.source, llvm::omp::Directive::OMPD_end_workshare);
258 break;
259 default:
260 // no clauses are allowed
261 break;
262 }
263 }
264
265 // Clauses
266 // Mainly categorized as
267 // 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
268 // 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
269 // 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
270
Leave(const parser::OmpClauseList &)271 void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
272 // 2.7 Loop Construct Restriction
273 if (llvm::omp::doSet.test(GetContext().directive)) {
274 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
275 // only one schedule clause is allowed
276 const auto &schedClause{std::get<parser::OmpScheduleClause>(clause->u)};
277 if (ScheduleModifierHasType(schedClause,
278 parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
279 if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
280 context_.Say(clause->source,
281 "The NONMONOTONIC modifier cannot be specified "
282 "if an ORDERED clause is specified"_err_en_US);
283 }
284 if (ScheduleModifierHasType(schedClause,
285 parser::OmpScheduleModifierType::ModType::Monotonic)) {
286 context_.Say(clause->source,
287 "The MONOTONIC and NONMONOTONIC modifiers "
288 "cannot be both specified"_err_en_US);
289 }
290 }
291 }
292
293 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
294 // only one ordered clause is allowed
295 const auto &orderedClause{
296 std::get<parser::OmpClause::Ordered>(clause->u)};
297
298 if (orderedClause.v) {
299 CheckNotAllowedIfClause(
300 llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
301
302 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
303 const auto &collapseClause{
304 std::get<parser::OmpClause::Collapse>(clause2->u)};
305 // ordered and collapse both have parameters
306 if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
307 if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
308 if (*orderedValue > 0 && *orderedValue < *collapseValue) {
309 context_.Say(clause->source,
310 "The parameter of the ORDERED clause must be "
311 "greater than or equal to "
312 "the parameter of the COLLAPSE clause"_err_en_US);
313 }
314 }
315 }
316 }
317 }
318
319 // TODO: ordered region binding check (requires nesting implementation)
320 }
321 } // doSet
322
323 // 2.8.1 Simd Construct Restriction
324 if (llvm::omp::simdSet.test(GetContext().directive)) {
325 if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
326 if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
327 const auto &simdlenClause{
328 std::get<parser::OmpClause::Simdlen>(clause->u)};
329 const auto &safelenClause{
330 std::get<parser::OmpClause::Safelen>(clause2->u)};
331 // simdlen and safelen both have parameters
332 if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
333 if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
334 if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
335 context_.Say(clause->source,
336 "The parameter of the SIMDLEN clause must be less than or "
337 "equal to the parameter of the SAFELEN clause"_err_en_US);
338 }
339 }
340 }
341 }
342 }
343 // TODO: A list-item cannot appear in more than one aligned clause
344 } // SIMD
345
346 // 2.7.3 Single Construct Restriction
347 if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
348 CheckNotAllowedIfClause(
349 llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
350 }
351
352 GetContext().requiredClauses.IterateOverMembers(
353 [this](llvm::omp::Clause c) { CheckRequired(c); });
354 }
355
Enter(const parser::OmpClause & x)356 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
357 SetContextClause(x);
358 }
359
360 // Following clauses do not have a seperate node in parse-tree.h.
361 // They fall under 'struct OmpClause' in parse-tree.h.
CHECK_SIMPLE_CLAUSE(Copyin,OMPC_copyin)362 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
363 CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate)
364 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
365 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
366 CHECK_SIMPLE_CLAUSE(Firstprivate, OMPC_firstprivate)
367 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
368 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
369 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
370 CHECK_SIMPLE_CLAUSE(Lastprivate, OMPC_lastprivate)
371 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
372 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
373 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
374 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
375 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
376 CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
377 CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
378 CHECK_SIMPLE_CLAUSE(UseDevicePtr, OMPC_use_device_ptr)
379 CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
380 CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
381 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
382 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
383 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
384
385 CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
386 CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
387 CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
388 CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
389 CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
390 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
391
392 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
393 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
394 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
395
396 // Restrictions specific to each clause are implemented apart from the
397 // generalized restrictions.
398 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
399 CheckAllowed(llvm::omp::Clause::OMPC_ordered);
400 // the parameter of ordered clause is optional
401 if (const auto &expr{x.v}) {
402 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
403 // 2.8.3 Loop SIMD Construct Restriction
404 if (llvm::omp::doSimdSet.test(GetContext().directive)) {
405 context_.Say(GetContext().clauseSource,
406 "No ORDERED clause with a parameter can be specified "
407 "on the %s directive"_err_en_US,
408 ContextDirectiveAsFortran());
409 }
410 }
411 }
412
Enter(const parser::OmpClause::Shared & x)413 void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
414 CheckAllowed(llvm::omp::Clause::OMPC_shared);
415 CheckIsVarPartOfAnotherVar(x.v);
416 }
Enter(const parser::OmpClause::Private & x)417 void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
418 CheckAllowed(llvm::omp::Clause::OMPC_private);
419 CheckIsVarPartOfAnotherVar(x.v);
420 CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
421 }
422
CheckIsVarPartOfAnotherVar(const parser::OmpObjectList & objList)423 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
424 const parser::OmpObjectList &objList) {
425
426 for (const auto &ompObject : objList.v) {
427 std::visit(
428 common::visitors{
429 [&](const parser::Designator &designator) {
430 if (std::get_if<parser::DataRef>(&designator.u)) {
431 if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
432 (parser::Unwrap<parser::ArrayElement>(ompObject))) {
433 context_.Say(GetContext().clauseSource,
434 "A variable that is part of another variable (as an "
435 "array or structure element)"
436 " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
437 }
438 }
439 },
440 [&](const parser::Name &name) {},
441 },
442 ompObject.u);
443 }
444 }
445 // Following clauses have a seperate node in parse-tree.h.
CHECK_SIMPLE_PARSER_CLAUSE(OmpAllocateClause,OMPC_allocate)446 CHECK_SIMPLE_PARSER_CLAUSE(OmpAllocateClause, OMPC_allocate)
447 CHECK_SIMPLE_PARSER_CLAUSE(OmpDefaultClause, OMPC_default)
448 CHECK_SIMPLE_PARSER_CLAUSE(OmpDistScheduleClause, OMPC_dist_schedule)
449 CHECK_SIMPLE_PARSER_CLAUSE(OmpNowait, OMPC_nowait)
450 CHECK_SIMPLE_PARSER_CLAUSE(OmpProcBindClause, OMPC_proc_bind)
451 CHECK_SIMPLE_PARSER_CLAUSE(OmpReductionClause, OMPC_reduction)
452
453 // Restrictions specific to each clause are implemented apart from the
454 // generalized restrictions.
455 void OmpStructureChecker::Enter(const parser::OmpAlignedClause &x) {
456 CheckAllowed(llvm::omp::Clause::OMPC_aligned);
457
458 if (const auto &expr{
459 std::get<std::optional<parser::ScalarIntConstantExpr>>(x.t)}) {
460 RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
461 }
462 // 2.8.1 TODO: list-item attribute check
463 }
Enter(const parser::OmpDefaultmapClause & x)464 void OmpStructureChecker::Enter(const parser::OmpDefaultmapClause &x) {
465 CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
466 using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
467 if (!std::get<std::optional<VariableCategory>>(x.t)) {
468 context_.Say(GetContext().clauseSource,
469 "The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
470 "clause"_err_en_US);
471 }
472 }
Enter(const parser::OmpIfClause & x)473 void OmpStructureChecker::Enter(const parser::OmpIfClause &x) {
474 CheckAllowed(llvm::omp::Clause::OMPC_if);
475
476 using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
477 static std::unordered_map<dirNameModifier, OmpDirectiveSet>
478 dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::parallelSet},
479 {dirNameModifier::Target, llvm::omp::targetSet},
480 {dirNameModifier::TargetEnterData,
481 {llvm::omp::Directive::OMPD_target_enter_data}},
482 {dirNameModifier::TargetExitData,
483 {llvm::omp::Directive::OMPD_target_exit_data}},
484 {dirNameModifier::TargetData,
485 {llvm::omp::Directive::OMPD_target_data}},
486 {dirNameModifier::TargetUpdate,
487 {llvm::omp::Directive::OMPD_target_update}},
488 {dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
489 {dirNameModifier::Taskloop, llvm::omp::taskloopSet}};
490 if (const auto &directiveName{
491 std::get<std::optional<dirNameModifier>>(x.t)}) {
492 auto search{dirNameModifierMap.find(*directiveName)};
493 if (search == dirNameModifierMap.end() ||
494 !search->second.test(GetContext().directive)) {
495 context_
496 .Say(GetContext().clauseSource,
497 "Unmatched directive name modifier %s on the IF clause"_err_en_US,
498 parser::ToUpperCaseLetters(
499 parser::OmpIfClause::EnumToString(*directiveName)))
500 .Attach(
501 GetContext().directiveSource, "Cannot apply to directive"_en_US);
502 }
503 }
504 }
505
Enter(const parser::OmpLinearClause & x)506 void OmpStructureChecker::Enter(const parser::OmpLinearClause &x) {
507 CheckAllowed(llvm::omp::Clause::OMPC_linear);
508
509 // 2.7 Loop Construct Restriction
510 if ((llvm::omp::doSet | llvm::omp::simdSet).test(GetContext().directive)) {
511 if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.u)) {
512 context_.Say(GetContext().clauseSource,
513 "A modifier may not be specified in a LINEAR clause "
514 "on the %s directive"_err_en_US,
515 ContextDirectiveAsFortran());
516 }
517 }
518 }
519
CheckAllowedMapTypes(const parser::OmpMapType::Type & type,const std::list<parser::OmpMapType::Type> & allowedMapTypeList)520 void OmpStructureChecker::CheckAllowedMapTypes(
521 const parser::OmpMapType::Type &type,
522 const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
523 const auto found{std::find(
524 std::begin(allowedMapTypeList), std::end(allowedMapTypeList), type)};
525 if (found == std::end(allowedMapTypeList)) {
526 std::string commaSeperatedMapTypes;
527 llvm::interleave(
528 allowedMapTypeList.begin(), allowedMapTypeList.end(),
529 [&](const parser::OmpMapType::Type &mapType) {
530 commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
531 parser::OmpMapType::EnumToString(mapType)));
532 },
533 [&] { commaSeperatedMapTypes.append(", "); });
534 context_.Say(GetContext().clauseSource,
535 "Only the %s map types are permitted "
536 "for MAP clauses on the %s directive"_err_en_US,
537 commaSeperatedMapTypes, ContextDirectiveAsFortran());
538 }
539 }
540
Enter(const parser::OmpMapClause & x)541 void OmpStructureChecker::Enter(const parser::OmpMapClause &x) {
542 CheckAllowed(llvm::omp::Clause::OMPC_map);
543 if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.t)}) {
544 using Type = parser::OmpMapType::Type;
545 const Type &type{std::get<Type>(maptype->t)};
546 switch (GetContext().directive) {
547 case llvm::omp::Directive::OMPD_target:
548 case llvm::omp::Directive::OMPD_target_teams:
549 case llvm::omp::Directive::OMPD_target_teams_distribute:
550 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
551 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
552 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
553 case llvm::omp::Directive::OMPD_target_data:
554 CheckAllowedMapTypes(
555 type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
556 break;
557 case llvm::omp::Directive::OMPD_target_enter_data:
558 CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
559 break;
560 case llvm::omp::Directive::OMPD_target_exit_data:
561 CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
562 break;
563 default:
564 break;
565 }
566 }
567 }
568
ScheduleModifierHasType(const parser::OmpScheduleClause & x,const parser::OmpScheduleModifierType::ModType & type)569 bool OmpStructureChecker::ScheduleModifierHasType(
570 const parser::OmpScheduleClause &x,
571 const parser::OmpScheduleModifierType::ModType &type) {
572 const auto &modifier{
573 std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
574 if (modifier) {
575 const auto &modType1{
576 std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
577 const auto &modType2{
578 std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
579 modifier->t)};
580 if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
581 return true;
582 }
583 }
584 return false;
585 }
Enter(const parser::OmpScheduleClause & x)586 void OmpStructureChecker::Enter(const parser::OmpScheduleClause &x) {
587 CheckAllowed(llvm::omp::Clause::OMPC_schedule);
588
589 // 2.7 Loop Construct Restriction
590 if (llvm::omp::doSet.test(GetContext().directive)) {
591 const auto &kind{std::get<1>(x.t)};
592 const auto &chunk{std::get<2>(x.t)};
593 if (chunk) {
594 if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
595 kind == parser::OmpScheduleClause::ScheduleType::Auto) {
596 context_.Say(GetContext().clauseSource,
597 "When SCHEDULE clause has %s specified, "
598 "it must not have chunk size specified"_err_en_US,
599 parser::ToUpperCaseLetters(
600 parser::OmpScheduleClause::EnumToString(kind)));
601 }
602 if (const auto &chunkExpr{
603 std::get<std::optional<parser::ScalarIntExpr>>(x.t)}) {
604 RequiresPositiveParameter(
605 llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
606 }
607 }
608
609 if (ScheduleModifierHasType(
610 x, parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
611 if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
612 kind != parser::OmpScheduleClause::ScheduleType::Guided) {
613 context_.Say(GetContext().clauseSource,
614 "The NONMONOTONIC modifier can only be specified with "
615 "SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
616 }
617 }
618 }
619 }
620
Enter(const parser::OmpDependClause & x)621 void OmpStructureChecker::Enter(const parser::OmpDependClause &x) {
622 CheckAllowed(llvm::omp::Clause::OMPC_depend);
623 if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.u)}) {
624 const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
625 for (const auto &ele : designators) {
626 if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
627 CheckDependList(*dataRef);
628 if (const auto *arr{
629 std::get_if<common::Indirection<parser::ArrayElement>>(
630 &dataRef->u)}) {
631 CheckDependArraySection(*arr, GetLastName(*dataRef));
632 }
633 }
634 }
635 }
636 }
637
getClauseName(llvm::omp::Clause clause)638 llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
639 return llvm::omp::getOpenMPClauseName(clause);
640 }
641
getDirectiveName(llvm::omp::Directive directive)642 llvm::StringRef OmpStructureChecker::getDirectiveName(
643 llvm::omp::Directive directive) {
644 return llvm::omp::getOpenMPDirectiveName(directive);
645 }
646
CheckDependList(const parser::DataRef & d)647 void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
648 std::visit(
649 common::visitors{
650 [&](const common::Indirection<parser::ArrayElement> &elem) {
651 // Check if the base element is valid on Depend Clause
652 CheckDependList(elem.value().base);
653 },
654 [&](const common::Indirection<parser::StructureComponent> &) {
655 context_.Say(GetContext().clauseSource,
656 "A variable that is part of another variable "
657 "(such as an element of a structure) but is not an array "
658 "element or an array section cannot appear in a DEPEND "
659 "clause"_err_en_US);
660 },
661 [&](const common::Indirection<parser::CoindexedNamedObject> &) {
662 context_.Say(GetContext().clauseSource,
663 "Coarrays are not supported in DEPEND clause"_err_en_US);
664 },
665 [&](const parser::Name &) { return; },
666 },
667 d.u);
668 }
669
CheckDependArraySection(const common::Indirection<parser::ArrayElement> & arr,const parser::Name & name)670 void OmpStructureChecker::CheckDependArraySection(
671 const common::Indirection<parser::ArrayElement> &arr,
672 const parser::Name &name) {
673 for (const auto &subscript : arr.value().subscripts) {
674 if (const auto *triplet{
675 std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
676 if (std::get<2>(triplet->t)) {
677 context_.Say(GetContext().clauseSource,
678 "Stride should not be specified for array section in DEPEND "
679 "clause"_err_en_US);
680 }
681 const auto &lower{std::get<0>(triplet->t)};
682 const auto &upper{std::get<1>(triplet->t)};
683 if (lower && upper) {
684 const auto lval{GetIntValue(lower)};
685 const auto uval{GetIntValue(upper)};
686 if (lval && uval && *uval < *lval) {
687 context_.Say(GetContext().clauseSource,
688 "'%s' in DEPEND clause is a zero size array section"_err_en_US,
689 name.ToString());
690 break;
691 }
692 }
693 }
694 }
695 }
696
CheckIntentInPointer(const parser::OmpObjectList & objectList,const llvm::omp::Clause clause)697 void OmpStructureChecker::CheckIntentInPointer(
698 const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
699 std::vector<const Symbol *> symbols;
700 GetSymbolsInObjectList(objectList, symbols);
701 for (const auto *symbol : symbols) {
702 if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
703 context_.Say(GetContext().clauseSource,
704 "Pointer '%s' with the INTENT(IN) attribute may not appear "
705 "in a %s clause"_err_en_US,
706 symbol->name(),
707 parser::ToUpperCaseLetters(getClauseName(clause).str()));
708 }
709 }
710 }
711
GetSymbolsInObjectList(const parser::OmpObjectList & objectList,std::vector<const Symbol * > & symbols)712 void OmpStructureChecker::GetSymbolsInObjectList(
713 const parser::OmpObjectList &objectList,
714 std::vector<const Symbol *> &symbols) {
715 for (const auto &ompObject : objectList.v) {
716 if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
717 if (const auto *symbol{name->symbol}) {
718 if (const auto *commonBlockDetails{
719 symbol->detailsIf<CommonBlockDetails>()}) {
720 for (const auto &object : commonBlockDetails->objects()) {
721 symbols.emplace_back(&object->GetUltimate());
722 }
723 } else {
724 symbols.emplace_back(&symbol->GetUltimate());
725 }
726 }
727 }
728 }
729 }
730
731 } // namespace Fortran::semantics
732