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