1//===-- lib/Semantics/check-omp-loop.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// Semantic checks for constructs and clauses related to loops.
10//
11//===----------------------------------------------------------------------===//
12
13#include "check-omp-structure.h"
14
15#include "check-directive-structure.h"
16#include "openmp-utils.h"
17
18#include "flang/Common/idioms.h"
19#include "flang/Common/visit.h"
20#include "flang/Parser/char-block.h"
21#include "flang/Parser/parse-tree-visitor.h"
22#include "flang/Parser/parse-tree.h"
23#include "flang/Parser/tools.h"
24#include "flang/Semantics/openmp-modifiers.h"
25#include "flang/Semantics/semantics.h"
26#include "flang/Semantics/symbol.h"
27#include "flang/Semantics/tools.h"
28#include "flang/Semantics/type.h"
29
30#include "llvm/Frontend/OpenMP/OMP.h"
31
32#include <cstdint>
33#include <map>
34#include <optional>
35#include <string>
36#include <tuple>
37#include <variant>
38
39namespace {
40using namespace Fortran;
41
42class AssociatedLoopChecker {
43public:
44 AssociatedLoopChecker(
45 semantics::SemanticsContext &context, std::int64_t level)
46 : context_{context}, level_{level} {}
47
48 template <typename T> bool Pre(const T &) { return true; }
49 template <typename T> void Post(const T &) {}
50
51 bool Pre(const parser::DoConstruct &dc) {
52 level_--;
53 const auto &doStmt{
54 std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
55 const auto &constructName{
56 std::get<std::optional<parser::Name>>(doStmt.statement.t)};
57 if (constructName) {
58 constructNamesAndLevels_.emplace(
59 constructName.value().ToString(), level_);
60 }
61 if (level_ >= 0) {
62 if (dc.IsDoWhile()) {
63 context_.Say(doStmt.source,
64 "The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
65 }
66 if (!dc.GetLoopControl()) {
67 context_.Say(doStmt.source,
68 "The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
69 }
70 }
71 return true;
72 }
73
74 void Post(const parser::DoConstruct &dc) { level_++; }
75
76 bool Pre(const parser::CycleStmt &cyclestmt) {
77 std::map<std::string, std::int64_t>::iterator it;
78 bool err{false};
79 if (cyclestmt.v) {
80 it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
81 err = (it != constructNamesAndLevels_.end() && it->second > 0);
82 } else { // If there is no label then use the level of the last enclosing DO
83 err = level_ > 0;
84 }
85 if (err) {
86 context_.Say(*source_,
87 "CYCLE statement to non-innermost associated loop of an OpenMP DO "
88 "construct"_err_en_US);
89 }
90 return true;
91 }
92
93 bool Pre(const parser::ExitStmt &exitStmt) {
94 std::map<std::string, std::int64_t>::iterator it;
95 bool err{false};
96 if (exitStmt.v) {
97 it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
98 err = (it != constructNamesAndLevels_.end() && it->second >= 0);
99 } else { // If there is no label then use the level of the last enclosing DO
100 err = level_ >= 0;
101 }
102 if (err) {
103 context_.Say(*source_,
104 "EXIT statement terminates associated loop of an OpenMP DO "
105 "construct"_err_en_US);
106 }
107 return true;
108 }
109
110 bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
111 source_ = &actionstmt.source;
112 return true;
113 }
114
115private:
116 semantics::SemanticsContext &context_;
117 const parser::CharBlock *source_;
118 std::int64_t level_;
119 std::map<std::string, std::int64_t> constructNamesAndLevels_;
120};
121} // namespace
122
123namespace Fortran::semantics {
124
125using namespace Fortran::semantics::omp;
126
127void OmpStructureChecker::HasInvalidDistributeNesting(
128 const parser::OpenMPLoopConstruct &x) {
129 bool violation{false};
130 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
131 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
132 if (llvm::omp::topDistributeSet.test(beginDir.v)) {
133 // `distribute` region has to be nested
134 if (!CurrentDirectiveIsNested()) {
135 violation = true;
136 } else {
137 // `distribute` region has to be strictly nested inside `teams`
138 if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
139 violation = true;
140 }
141 }
142 }
143 if (violation) {
144 context_.Say(beginDir.source,
145 "`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
146 "region."_err_en_US);
147 }
148}
149void OmpStructureChecker::HasInvalidLoopBinding(
150 const parser::OpenMPLoopConstruct &x) {
151 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
152 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
153
154 auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
155 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
156 for (const auto &clause : clauseList.v) {
157 if (const auto *bindClause{
158 std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
159 if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {
160 context_.Say(beginDir.source, msg);
161 }
162 }
163 }
164 };
165
166 if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
167 CurrentDirectiveIsNested() &&
168 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
169 teamsBindingChecker(
170 "`BIND(TEAMS)` must be specified since the `LOOP` region is "
171 "strictly nested inside a `TEAMS` region."_err_en_US);
172 }
173
174 if (OmpDirectiveSet{
175 llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
176 .test(beginDir.v)) {
177 teamsBindingChecker(
178 "`BIND(TEAMS)` must be specified since the `LOOP` directive is "
179 "combined with a `TEAMS` construct."_err_en_US);
180 }
181}
182
183void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
184 // Check the following:
185 // The only OpenMP constructs that can be encountered during execution of
186 // a simd region are the `atomic` construct, the `loop` construct, the `simd`
187 // construct and the `ordered` construct with the `simd` clause.
188
189 // Check if the parent context has the SIMD clause
190 // Please note that we use GetContext() instead of GetContextParent()
191 // because PushContextAndClauseSets() has not been called on the
192 // current context yet.
193 // TODO: Check for declare simd regions.
194 bool eligibleSIMD{false};
195 common::visit(
196 common::visitors{
197 // Allow `!$OMP ORDERED SIMD`
198 [&](const parser::OpenMPBlockConstruct &c) {
199 const auto &beginBlockDir{
200 std::get<parser::OmpBeginBlockDirective>(c.t)};
201 const auto &beginDir{
202 std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
203 if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
204 const auto &clauses{
205 std::get<parser::OmpClauseList>(beginBlockDir.t)};
206 for (const auto &clause : clauses.v) {
207 if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
208 eligibleSIMD = true;
209 break;
210 }
211 }
212 }
213 },
214 [&](const parser::OpenMPStandaloneConstruct &c) {
215 if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
216 &c.u)}) {
217 llvm::omp::Directive dirId{ssc->v.DirId()};
218 if (dirId == llvm::omp::Directive::OMPD_ordered) {
219 for (const parser::OmpClause &x : ssc->v.Clauses().v) {
220 if (x.Id() == llvm::omp::Clause::OMPC_simd) {
221 eligibleSIMD = true;
222 break;
223 }
224 }
225 } else if (dirId == llvm::omp::Directive::OMPD_scan) {
226 eligibleSIMD = true;
227 }
228 }
229 },
230 // Allowing SIMD and loop construct
231 [&](const parser::OpenMPLoopConstruct &c) {
232 const auto &beginLoopDir{
233 std::get<parser::OmpBeginLoopDirective>(c.t)};
234 const auto &beginDir{
235 std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
236 if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
237 (beginDir.v == llvm::omp::Directive::OMPD_do_simd) ||
238 (beginDir.v == llvm::omp::Directive::OMPD_loop)) {
239 eligibleSIMD = true;
240 }
241 },
242 [&](const parser::OpenMPAtomicConstruct &c) {
243 // Allow `!$OMP ATOMIC`
244 eligibleSIMD = true;
245 },
246 [&](const auto &c) {},
247 },
248 c.u);
249 if (!eligibleSIMD) {
250 context_.Say(parser::FindSourceLocation(c),
251 "The only OpenMP constructs that can be encountered during execution "
252 "of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
253 "the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
254 "construct with the `SIMD` clause."_err_en_US);
255 }
256}
257
258void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
259 loopStack_.push_back(&x);
260 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
261 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
262
263 PushContextAndClauseSets(beginDir.source, beginDir.v);
264
265 // check matching, End directive is optional
266 if (const auto &endLoopDir{
267 std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
268 const auto &endDir{
269 std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
270
271 CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
272
273 AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endLoopDir->t));
274 }
275
276 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
277 EnterDirectiveNest(index: SIMDNest);
278 }
279
280 // Combined target loop constructs are target device constructs. Keep track of
281 // whether any such construct has been visited to later check that REQUIRES
282 // directives for target-related options don't appear after them.
283 if (llvm::omp::allTargetSet.test(beginDir.v)) {
284 deviceConstructFound_ = true;
285 }
286
287 if (beginDir.v == llvm::omp::Directive::OMPD_do) {
288 // 2.7.1 do-clause -> private-clause |
289 // firstprivate-clause |
290 // lastprivate-clause |
291 // linear-clause |
292 // reduction-clause |
293 // schedule-clause |
294 // collapse-clause |
295 // ordered-clause
296
297 // nesting check
298 HasInvalidWorksharingNesting(
299 beginDir.source, llvm::omp::nestedWorkshareErrSet);
300 }
301 SetLoopInfo(x);
302
303 auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
304 if (optLoopCons.has_value()) {
305 if (const auto &doConstruct{
306 std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
307 const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
308 CheckNoBranching(doBlock, beginDir.v, beginDir.source);
309 }
310 }
311 CheckLoopItrVariableIsInt(x);
312 CheckAssociatedLoopConstraints(x);
313 HasInvalidDistributeNesting(x);
314 HasInvalidLoopBinding(x);
315 if (CurrentDirectiveIsNested() &&
316 llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
317 HasInvalidTeamsNesting(beginDir.v, beginDir.source);
318 }
319 if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
320 (beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
321 CheckDistLinear(x);
322 }
323}
324
325const parser::Name OmpStructureChecker::GetLoopIndex(
326 const parser::DoConstruct *x) {
327 using Bounds = parser::LoopControl::Bounds;
328 return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
329}
330
331void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
332 auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
333 if (optLoopCons.has_value()) {
334 if (const auto &loopConstruct{
335 std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
336 const parser::DoConstruct *loop{&*loopConstruct};
337 if (loop && loop->IsDoNormal()) {
338 const parser::Name &itrVal{GetLoopIndex(loop)};
339 SetLoopIv(itrVal.symbol);
340 }
341 }
342 }
343}
344
345void OmpStructureChecker::CheckLoopItrVariableIsInt(
346 const parser::OpenMPLoopConstruct &x) {
347 auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
348 if (optLoopCons.has_value()) {
349 if (const auto &loopConstruct{
350 std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
351
352 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
353 if (loop->IsDoNormal()) {
354 const parser::Name &itrVal{GetLoopIndex(loop)};
355 if (itrVal.symbol) {
356 const auto *type{itrVal.symbol->GetType()};
357 if (!type->IsNumeric(TypeCategory::Integer)) {
358 context_.Say(itrVal.source,
359 "The DO loop iteration"
360 " variable must be of the type integer."_err_en_US,
361 itrVal.ToString());
362 }
363 }
364 }
365 // Get the next DoConstruct if block is not empty.
366 const auto &block{std::get<parser::Block>(loop->t)};
367 const auto it{block.begin()};
368 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
369 : nullptr;
370 }
371 }
372 }
373}
374
375std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
376 const parser::OpenMPLoopConstruct &x) {
377 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
378 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
379 std::int64_t orderedCollapseLevel{1};
380 std::int64_t orderedLevel{1};
381 std::int64_t collapseLevel{1};
382
383 for (const auto &clause : clauseList.v) {
384 if (const auto *collapseClause{
385 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
386 if (const auto v{GetIntValue(collapseClause->v)}) {
387 collapseLevel = *v;
388 }
389 }
390 if (const auto *orderedClause{
391 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
392 if (const auto v{GetIntValue(orderedClause->v)}) {
393 orderedLevel = *v;
394 }
395 }
396 }
397 if (orderedLevel >= collapseLevel) {
398 orderedCollapseLevel = orderedLevel;
399 } else {
400 orderedCollapseLevel = collapseLevel;
401 }
402 return orderedCollapseLevel;
403}
404
405void OmpStructureChecker::CheckAssociatedLoopConstraints(
406 const parser::OpenMPLoopConstruct &x) {
407 std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
408 AssociatedLoopChecker checker{context_, ordCollapseLevel};
409 parser::Walk(x, checker);
410}
411
412void OmpStructureChecker::CheckDistLinear(
413 const parser::OpenMPLoopConstruct &x) {
414
415 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
416 const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
417
418 SymbolSourceMap indexVars;
419
420 // Collect symbols of all the variables from linear clauses
421 for (auto &clause : clauses.v) {
422 if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
423 auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};
424 GetSymbolsInObjectList(objects, indexVars);
425 }
426 }
427
428 if (!indexVars.empty()) {
429 // Get collapse level, if given, to find which loops are "associated."
430 std::int64_t collapseVal{GetOrdCollapseLevel(x)};
431 // Include the top loop if no collapse is specified
432 if (collapseVal == 0) {
433 collapseVal = 1;
434 }
435
436 // Match the loop index variables with the collected symbols from linear
437 // clauses.
438 auto &optLoopCons = std::get<std::optional<parser::NestedConstruct>>(x.t);
439 if (optLoopCons.has_value()) {
440 if (const auto &loopConstruct{
441 std::get_if<parser::DoConstruct>(&*optLoopCons)}) {
442 for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
443 if (loop->IsDoNormal()) {
444 const parser::Name &itrVal{GetLoopIndex(loop)};
445 if (itrVal.symbol) {
446 // Remove the symbol from the collected set
447 indexVars.erase(&itrVal.symbol->GetUltimate());
448 }
449 collapseVal--;
450 if (collapseVal == 0) {
451 break;
452 }
453 }
454 // Get the next DoConstruct if block is not empty.
455 const auto &block{std::get<parser::Block>(loop->t)};
456 const auto it{block.begin()};
457 loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
458 : nullptr;
459 }
460 }
461 }
462
463 // Show error for the remaining variables
464 for (auto &[symbol, source] : indexVars) {
465 const Symbol &root{GetAssociationRoot(*symbol)};
466 context_.Say(source,
467 "Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,
468 root.name());
469 }
470 }
471}
472
473void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
474 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
475 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
476
477 // A few semantic checks for InScan reduction are performed below as SCAN
478 // constructs inside LOOP may add the relevant information. Scan reduction is
479 // supported only in loop constructs, so same checks are not applicable to
480 // other directives.
481 using ReductionModifier = parser::OmpReductionModifier;
482 for (const auto &clause : clauseList.v) {
483 if (const auto *reductionClause{
484 std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
485 auto &modifiers{OmpGetModifiers(reductionClause->v)};
486 auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};
487 if (maybeModifier &&
488 maybeModifier->v == ReductionModifier::Value::Inscan) {
489 const auto &objectList{
490 std::get<parser::OmpObjectList>(reductionClause->v.t)};
491 auto checkReductionSymbolInScan = [&](const parser::Name *name) {
492 if (auto &symbol = name->symbol) {
493 if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
494 !symbol->test(Symbol::Flag::OmpExclusiveScan)) {
495 context_.Say(name->source,
496 "List item %s must appear in EXCLUSIVE or "
497 "INCLUSIVE clause of an "
498 "enclosed SCAN directive"_err_en_US,
499 name->ToString());
500 }
501 }
502 };
503 for (const auto &ompObj : objectList.v) {
504 common::visit(
505 common::visitors{
506 [&](const parser::Designator &designator) {
507 if (const auto *name{semantics::getDesignatorNameIfDataRef(
508 designator)}) {
509 checkReductionSymbolInScan(name);
510 }
511 },
512 [&](const auto &name) { checkReductionSymbolInScan(&name); },
513 },
514 ompObj.u);
515 }
516 }
517 }
518 }
519 if (llvm::omp::allSimdSet.test(GetContext().directive)) {
520 ExitDirectiveNest(index: SIMDNest);
521 }
522 dirContext_.pop_back();
523
524 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
525#ifndef NDEBUG
526 const LoopConstruct &top{loopStack_.back()};
527 auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
528 assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
529#endif
530 loopStack_.pop_back();
531}
532
533void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
534 const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
535 ResetPartialContext(dir.source);
536 switch (dir.v) {
537 // 2.7.1 end-do -> END DO [nowait-clause]
538 // 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
539 case llvm::omp::Directive::OMPD_do:
540 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
541 break;
542 case llvm::omp::Directive::OMPD_do_simd:
543 PushContextAndClauseSets(
544 dir.source, llvm::omp::Directive::OMPD_end_do_simd);
545 break;
546 default:
547 // no clauses are allowed
548 break;
549 }
550}
551
552void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
553 if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
554 (GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
555 dirContext_.pop_back();
556 }
557}
558
559void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
560 CheckAllowedClause(clause: llvm::omp::Clause::OMPC_linear);
561 unsigned version{context_.langOptions().OpenMPVersion};
562 llvm::omp::Directive dir{GetContext().directive};
563 parser::CharBlock clauseSource{GetContext().clauseSource};
564 const parser::OmpLinearModifier *linearMod{nullptr};
565
566 SymbolSourceMap symbols;
567 auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
568 CheckCrayPointee(objects, "LINEAR", false);
569 GetSymbolsInObjectList(objects, symbols);
570
571 auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {
572 if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
573 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
574 context_.Say(source,
575 "The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,
576 symbol->name(), desc.name.str());
577 }
578 }};
579
580 if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {
581 auto &modifiers{OmpGetModifiers(x.v)};
582 linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);
583 if (linearMod) {
584 // 2.7 Loop Construct Restriction
585 if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {
586 context_.Say(clauseSource,
587 "A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,
588 ContextDirectiveAsFortran());
589 return;
590 }
591
592 auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
593 for (auto &[symbol, source] : symbols) {
594 if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {
595 CheckIntegerNoRef(symbol, source);
596 } else {
597 if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&
598 !IsPolymorphic(*symbol)) {
599 context_.Say(source,
600 "The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,
601 symbol->name(), desc.name.str());
602 }
603 }
604 if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||
605 linearMod->v == parser::OmpLinearModifier::Value::Uval) {
606 if (!IsDummy(*symbol) || IsValue(*symbol)) {
607 context_.Say(source,
608 "If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,
609 desc.name.str(), symbol->name());
610 }
611 }
612 } // for (symbol, source)
613
614 if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {
615 context_.Say(OmpGetModifierSource(modifiers, linearMod),
616 "The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,
617 ThisVersion(version));
618 }
619 }
620 }
621
622 // OpenMP 5.2: Ordered clause restriction
623 if (const auto *clause{
624 FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {
625 const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};
626 if (orderedClause.v) {
627 return;
628 }
629 }
630
631 // OpenMP 5.2: Linear clause Restrictions
632 for (auto &[symbol, source] : symbols) {
633 if (!linearMod) {
634 // Already checked this with the modifier present.
635 CheckIntegerNoRef(symbol, source);
636 }
637 if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {
638 context_.Say(source,
639 "The list item `%s` must be a dummy argument"_err_en_US,
640 symbol->name());
641 }
642 if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {
643 context_.Say(source,
644 "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,
645 symbol->name());
646 }
647 if (FindCommonBlockContaining(*symbol)) {
648 context_.Say(source,
649 "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,
650 symbol->name());
651 }
652 }
653}
654
655void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
656 Base::Enter(x);
657 loopStack_.push_back(&x);
658}
659
660void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
661 assert(!loopStack_.empty() && "Expecting non-empty loop stack");
662#ifndef NDEBUG
663 const LoopConstruct &top = loopStack_.back();
664 auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
665 assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
666#endif
667 loopStack_.pop_back();
668 Base::Leave(x);
669}
670
671} // namespace Fortran::semantics
672

source code of flang/lib/Semantics/check-omp-loop.cpp