1 //===-- lib/Semantics/check-directive-structure.h ---------------*- C++ -*-===//
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 // Directive structure validity checks common to OpenMP, OpenACC and other
10 // directive language.
11
12 #ifndef FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
13 #define FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
14
15 #include "flang/Common/enum-set.h"
16 #include "flang/Semantics/semantics.h"
17 #include "flang/Semantics/tools.h"
18 #include <unordered_map>
19
20 namespace Fortran::semantics {
21
22 template <typename C, std::size_t ClauseEnumSize> struct DirectiveClauses {
23 const common::EnumSet<C, ClauseEnumSize> allowed;
24 const common::EnumSet<C, ClauseEnumSize> allowedOnce;
25 const common::EnumSet<C, ClauseEnumSize> allowedExclusive;
26 const common::EnumSet<C, ClauseEnumSize> requiredOneOf;
27 };
28
29 // Generic branching checker for invalid branching out of OpenMP/OpenACC
30 // directive.
31 // typename D is the directive enumeration.
32 template <typename D> class NoBranchingEnforce {
33 public:
NoBranchingEnforce(SemanticsContext & context,parser::CharBlock sourcePosition,D directive,std::string && upperCaseDirName)34 NoBranchingEnforce(SemanticsContext &context,
35 parser::CharBlock sourcePosition, D directive,
36 std::string &&upperCaseDirName)
37 : context_{context}, sourcePosition_{sourcePosition},
38 upperCaseDirName_{std::move(upperCaseDirName)}, currentDirective_{
39 directive} {}
Pre(const T &)40 template <typename T> bool Pre(const T &) { return true; }
Post(const T &)41 template <typename T> void Post(const T &) {}
42
Pre(const parser::Statement<T> & statement)43 template <typename T> bool Pre(const parser::Statement<T> &statement) {
44 currentStatementSourcePosition_ = statement.source;
45 return true;
46 }
47
Post(const parser::ReturnStmt &)48 void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); }
Post(const parser::ExitStmt & exitStmt)49 void Post(const parser::ExitStmt &exitStmt) {
50 if (const auto &exitName{exitStmt.v}) {
51 CheckConstructNameBranching("EXIT", exitName.value());
52 }
53 }
Post(const parser::StopStmt &)54 void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); }
Post(const parser::CycleStmt & cycleStmt)55 void Post(const parser::CycleStmt &cycleStmt) {
56 if (const auto &cycleName{cycleStmt.v}) {
57 CheckConstructNameBranching("CYCLE", cycleName.value());
58 }
59 }
60
61 private:
GetEnclosingMsg()62 parser::MessageFormattedText GetEnclosingMsg() const {
63 return {"Enclosing %s construct"_en_US, upperCaseDirName_};
64 }
65
EmitBranchOutError(const char * stmt)66 void EmitBranchOutError(const char *stmt) const {
67 context_
68 .Say(currentStatementSourcePosition_,
69 "%s statement is not allowed in a %s construct"_err_en_US, stmt,
70 upperCaseDirName_)
71 .Attach(sourcePosition_, GetEnclosingMsg());
72 }
73
EmitBranchOutErrorWithName(const char * stmt,const parser::Name & toName)74 void EmitBranchOutErrorWithName(
75 const char *stmt, const parser::Name &toName) const {
76 const std::string branchingToName{toName.ToString()};
77 context_
78 .Say(currentStatementSourcePosition_,
79 "%s to construct '%s' outside of %s construct is not allowed"_err_en_US,
80 stmt, branchingToName, upperCaseDirName_)
81 .Attach(sourcePosition_, GetEnclosingMsg());
82 }
83
84 // Current semantic checker is not following OpenACC/OpenMP constructs as they
85 // are not Fortran constructs. Hence the ConstructStack doesn't capture
86 // OpenACC/OpenMP constructs. Apply an inverse way to figure out if a
87 // construct-name is branching out of an OpenACC/OpenMP construct. The control
88 // flow goes out of an OpenACC/OpenMP construct, if a construct-name from
89 // statement is found in ConstructStack.
CheckConstructNameBranching(const char * stmt,const parser::Name & stmtName)90 void CheckConstructNameBranching(
91 const char *stmt, const parser::Name &stmtName) {
92 const ConstructStack &stack{context_.constructStack()};
93 for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {
94 const ConstructNode &construct{*iter};
95 const auto &constructName{MaybeGetNodeName(construct)};
96 if (constructName) {
97 if (stmtName.source == constructName->source) {
98 EmitBranchOutErrorWithName(stmt, stmtName);
99 return;
100 }
101 }
102 }
103 }
104
105 SemanticsContext &context_;
106 parser::CharBlock currentStatementSourcePosition_;
107 parser::CharBlock sourcePosition_;
108 std::string upperCaseDirName_;
109 D currentDirective_;
110 };
111
112 // Generic structure checker for directives/clauses language such as OpenMP
113 // and OpenACC.
114 // typename D is the directive enumeration.
115 // tyepname C is the clause enumeration.
116 // typename PC is the parser class defined in parse-tree.h for the clauses.
117 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
118 class DirectiveStructureChecker : public virtual BaseChecker {
119 protected:
DirectiveStructureChecker(SemanticsContext & context,std::unordered_map<D,DirectiveClauses<C,ClauseEnumSize>> directiveClausesMap)120 DirectiveStructureChecker(SemanticsContext &context,
121 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
122 directiveClausesMap)
123 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
~DirectiveStructureChecker()124 virtual ~DirectiveStructureChecker() {}
125
126 using ClauseMapTy = std::multimap<C, const PC *>;
127 struct DirectiveContext {
DirectiveContextDirectiveContext128 DirectiveContext(parser::CharBlock source, D d)
129 : directiveSource{source}, directive{d} {}
130
131 parser::CharBlock directiveSource{nullptr};
132 parser::CharBlock clauseSource{nullptr};
133 D directive;
134 common::EnumSet<C, ClauseEnumSize> allowedClauses{};
135 common::EnumSet<C, ClauseEnumSize> allowedOnceClauses{};
136 common::EnumSet<C, ClauseEnumSize> allowedExclusiveClauses{};
137 common::EnumSet<C, ClauseEnumSize> requiredClauses{};
138
139 const PC *clause{nullptr};
140 ClauseMapTy clauseInfo;
141 std::list<C> actualClauses;
142 Symbol *loopIV{nullptr};
143 };
144
SetLoopIv(Symbol * symbol)145 void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
146
147 // back() is the top of the stack
GetContext()148 DirectiveContext &GetContext() {
149 CHECK(!dirContext_.empty());
150 return dirContext_.back();
151 }
152
GetContextParent()153 DirectiveContext &GetContextParent() {
154 CHECK(dirContext_.size() >= 2);
155 return dirContext_[dirContext_.size() - 2];
156 }
157
SetContextClause(const PC & clause)158 void SetContextClause(const PC &clause) {
159 GetContext().clauseSource = clause.source;
160 GetContext().clause = &clause;
161 }
162
ResetPartialContext(const parser::CharBlock & source)163 void ResetPartialContext(const parser::CharBlock &source) {
164 CHECK(!dirContext_.empty());
165 SetContextDirectiveSource(source);
166 GetContext().allowedClauses = {};
167 GetContext().allowedOnceClauses = {};
168 GetContext().allowedExclusiveClauses = {};
169 GetContext().requiredClauses = {};
170 GetContext().clauseInfo = {};
171 GetContext().loopIV = {nullptr};
172 }
173
SetContextDirectiveSource(const parser::CharBlock & directive)174 void SetContextDirectiveSource(const parser::CharBlock &directive) {
175 GetContext().directiveSource = directive;
176 }
177
SetContextDirectiveEnum(D dir)178 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
179
SetContextAllowed(const common::EnumSet<C,ClauseEnumSize> & allowed)180 void SetContextAllowed(const common::EnumSet<C, ClauseEnumSize> &allowed) {
181 GetContext().allowedClauses = allowed;
182 }
183
SetContextAllowedOnce(const common::EnumSet<C,ClauseEnumSize> & allowedOnce)184 void SetContextAllowedOnce(
185 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
186 GetContext().allowedOnceClauses = allowedOnce;
187 }
188
SetContextAllowedExclusive(const common::EnumSet<C,ClauseEnumSize> & allowedExclusive)189 void SetContextAllowedExclusive(
190 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
191 GetContext().allowedExclusiveClauses = allowedExclusive;
192 }
193
SetContextRequired(const common::EnumSet<C,ClauseEnumSize> & required)194 void SetContextRequired(const common::EnumSet<C, ClauseEnumSize> &required) {
195 GetContext().requiredClauses = required;
196 }
197
SetContextClauseInfo(C type)198 void SetContextClauseInfo(C type) {
199 GetContext().clauseInfo.emplace(type, GetContext().clause);
200 }
201
AddClauseToCrtContext(C type)202 void AddClauseToCrtContext(C type) {
203 GetContext().actualClauses.push_back(type);
204 }
205
EnterSIMDNest()206 void EnterSIMDNest() { simdNest_++; }
207
ExitSIMDNest()208 void ExitSIMDNest() { simdNest_--; }
209
GetSIMDNest()210 int GetSIMDNest() { return simdNest_; }
211
212 // Check if the given clause is present in the current context
FindClause(C type)213 const PC *FindClause(C type) {
214 auto it{GetContext().clauseInfo.find(type)};
215 if (it != GetContext().clauseInfo.end()) {
216 return it->second;
217 }
218 return nullptr;
219 }
220
221 // Check if the given clause is present in the parent context
FindClauseParent(C type)222 const PC *FindClauseParent(C type) {
223 auto it{GetContextParent().clauseInfo.find(type)};
224 if (it != GetContextParent().clauseInfo.end()) {
225 return it->second;
226 }
227 return nullptr;
228 }
229
230 std::pair<typename ClauseMapTy::iterator, typename ClauseMapTy::iterator>
FindClauses(C type)231 FindClauses(C type) {
232 auto it{GetContext().clauseInfo.equal_range(type)};
233 return it;
234 }
235
GetEnclosingDirContext()236 DirectiveContext *GetEnclosingDirContext() {
237 CHECK(!dirContext_.empty());
238 auto it{dirContext_.rbegin()};
239 if (++it != dirContext_.rend()) {
240 return &(*it);
241 }
242 return nullptr;
243 }
244
PushContext(const parser::CharBlock & source,D dir)245 void PushContext(const parser::CharBlock &source, D dir) {
246 dirContext_.emplace_back(source, dir);
247 }
248
GetEnclosingContextWithDir(D dir)249 DirectiveContext *GetEnclosingContextWithDir(D dir) {
250 CHECK(!dirContext_.empty());
251 auto it{dirContext_.rbegin()};
252 while (++it != dirContext_.rend()) {
253 if (it->directive == dir) {
254 return &(*it);
255 }
256 }
257 return nullptr;
258 }
259
CurrentDirectiveIsNested()260 bool CurrentDirectiveIsNested() { return dirContext_.size() > 1; };
261
SetClauseSets(D dir)262 void SetClauseSets(D dir) {
263 dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
264 dirContext_.back().allowedOnceClauses =
265 directiveClausesMap_[dir].allowedOnce;
266 dirContext_.back().allowedExclusiveClauses =
267 directiveClausesMap_[dir].allowedExclusive;
268 dirContext_.back().requiredClauses =
269 directiveClausesMap_[dir].requiredOneOf;
270 }
PushContextAndClauseSets(const parser::CharBlock & source,D dir)271 void PushContextAndClauseSets(const parser::CharBlock &source, D dir) {
272 PushContext(source, dir);
273 SetClauseSets(dir);
274 }
275
276 void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
277
CheckMatching(const B & beginDir,const B & endDir)278 template <typename B> void CheckMatching(const B &beginDir, const B &endDir) {
279 const auto &begin{beginDir.v};
280 const auto &end{endDir.v};
281 if (begin != end) {
282 SayNotMatching(beginDir.source, endDir.source);
283 }
284 }
285 // Check illegal branching out of `Parser::Block` for `Parser::Name` based
286 // nodes (example `Parser::ExitStmt`)
287 void CheckNoBranching(const parser::Block &block, D directive,
288 const parser::CharBlock &directiveSource);
289
290 // Check that only clauses in set are after the specific clauses.
291 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
292
293 void CheckRequireAtLeastOneOf();
294
295 void CheckAllowed(C clause);
296
297 void CheckAtLeastOneClause();
298
299 void CheckNotAllowedIfClause(
300 C clause, common::EnumSet<C, ClauseEnumSize> set);
301
302 std::string ContextDirectiveAsFortran();
303
304 void RequiresConstantPositiveParameter(
305 const C &clause, const parser::ScalarIntConstantExpr &i);
306
307 void RequiresPositiveParameter(const C &clause,
308 const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter");
309
310 void OptionalConstantPositiveParameter(
311 const C &clause, const std::optional<parser::ScalarIntConstantExpr> &o);
312
getClauseName(C clause)313 virtual llvm::StringRef getClauseName(C clause) { return ""; };
314
getDirectiveName(D directive)315 virtual llvm::StringRef getDirectiveName(D directive) { return ""; };
316
317 SemanticsContext &context_;
318 std::vector<DirectiveContext> dirContext_; // used as a stack
319 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
320 directiveClausesMap_;
321
322 std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
323 int simdNest_{0};
324 };
325
326 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckNoBranching(const parser::Block & block,D directive,const parser::CharBlock & directiveSource)327 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
328 const parser::Block &block, D directive,
329 const parser::CharBlock &directiveSource) {
330 NoBranchingEnforce<D> noBranchingEnforce{
331 context_, directiveSource, directive, ContextDirectiveAsFortran()};
332 parser::Walk(block, noBranchingEnforce);
333 }
334
335 // Check that only clauses included in the given set are present after the given
336 // clause.
337 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckOnlyAllowedAfter(C clause,common::EnumSet<C,ClauseEnumSize> set)338 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
339 C clause, common::EnumSet<C, ClauseEnumSize> set) {
340 bool enforceCheck = false;
341 for (auto cl : GetContext().actualClauses) {
342 if (cl == clause) {
343 enforceCheck = true;
344 continue;
345 } else if (enforceCheck && !set.test(cl)) {
346 auto parserClause = GetContext().clauseInfo.find(cl);
347 context_.Say(parserClause->second->source,
348 "Clause %s is not allowed after clause %s on the %s "
349 "directive"_err_en_US,
350 parser::ToUpperCaseLetters(getClauseName(cl).str()),
351 parser::ToUpperCaseLetters(getClauseName(clause).str()),
352 ContextDirectiveAsFortran());
353 }
354 }
355 }
356
357 // Check that at least one clause is attached to the directive.
358 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
359 void DirectiveStructureChecker<D, C, PC,
CheckAtLeastOneClause()360 ClauseEnumSize>::CheckAtLeastOneClause() {
361 if (GetContext().actualClauses.empty()) {
362 context_.Say(GetContext().directiveSource,
363 "At least one clause is required on the %s directive"_err_en_US,
364 ContextDirectiveAsFortran());
365 }
366 }
367
368 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
369 std::string
ClauseSetToString(const common::EnumSet<C,ClauseEnumSize> set)370 DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
371 const common::EnumSet<C, ClauseEnumSize> set) {
372 std::string list;
373 set.IterateOverMembers([&](C o) {
374 if (!list.empty())
375 list.append(", ");
376 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
377 });
378 return list;
379 }
380
381 // Check that at least one clause in the required set is present on the
382 // directive.
383 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
384 void DirectiveStructureChecker<D, C, PC,
CheckRequireAtLeastOneOf()385 ClauseEnumSize>::CheckRequireAtLeastOneOf() {
386 if (GetContext().requiredClauses.empty())
387 return;
388 for (auto cl : GetContext().actualClauses) {
389 if (GetContext().requiredClauses.test(cl))
390 return;
391 }
392 // No clause matched in the actual clauses list
393 context_.Say(GetContext().directiveSource,
394 "At least one of %s clause must appear on the %s directive"_err_en_US,
395 ClauseSetToString(GetContext().requiredClauses),
396 ContextDirectiveAsFortran());
397 }
398
399 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
400 std::string DirectiveStructureChecker<D, C, PC,
ContextDirectiveAsFortran()401 ClauseEnumSize>::ContextDirectiveAsFortran() {
402 return parser::ToUpperCaseLetters(
403 getDirectiveName(GetContext().directive).str());
404 }
405
406 // Check that clauses present on the directive are allowed clauses.
407 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckAllowed(C clause)408 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
409 C clause) {
410 if (!GetContext().allowedClauses.test(clause) &&
411 !GetContext().allowedOnceClauses.test(clause) &&
412 !GetContext().allowedExclusiveClauses.test(clause) &&
413 !GetContext().requiredClauses.test(clause)) {
414 context_.Say(GetContext().clauseSource,
415 "%s clause is not allowed on the %s directive"_err_en_US,
416 parser::ToUpperCaseLetters(getClauseName(clause).str()),
417 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
418 return;
419 }
420 if ((GetContext().allowedOnceClauses.test(clause) ||
421 GetContext().allowedExclusiveClauses.test(clause)) &&
422 FindClause(clause)) {
423 context_.Say(GetContext().clauseSource,
424 "At most one %s clause can appear on the %s directive"_err_en_US,
425 parser::ToUpperCaseLetters(getClauseName(clause).str()),
426 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
427 return;
428 }
429 if (GetContext().allowedExclusiveClauses.test(clause)) {
430 std::vector<C> others;
431 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
432 if (FindClause(o)) {
433 others.emplace_back(o);
434 }
435 });
436 for (const auto &e : others) {
437 context_.Say(GetContext().clauseSource,
438 "%s and %s clauses are mutually exclusive and may not appear on the "
439 "same %s directive"_err_en_US,
440 parser::ToUpperCaseLetters(getClauseName(clause).str()),
441 parser::ToUpperCaseLetters(getClauseName(e).str()),
442 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
443 }
444 if (!others.empty()) {
445 return;
446 }
447 }
448 SetContextClauseInfo(clause);
449 AddClauseToCrtContext(clause);
450 }
451
452 // Enforce restriction where clauses in the given set are not allowed if the
453 // given clause appears.
454 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
455 void DirectiveStructureChecker<D, C, PC,
CheckNotAllowedIfClause(C clause,common::EnumSet<C,ClauseEnumSize> set)456 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
457 common::EnumSet<C, ClauseEnumSize> set) {
458 if (std::find(GetContext().actualClauses.begin(),
459 GetContext().actualClauses.end(),
460 clause) == GetContext().actualClauses.end()) {
461 return; // Clause is not present
462 }
463
464 for (auto cl : GetContext().actualClauses) {
465 if (set.test(cl)) {
466 context_.Say(GetContext().directiveSource,
467 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
468 parser::ToUpperCaseLetters(getClauseName(cl).str()),
469 parser::ToUpperCaseLetters(getClauseName(clause).str()),
470 ContextDirectiveAsFortran());
471 }
472 }
473 }
474
475 // Check the value of the clause is a constant positive integer.
476 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
477 void DirectiveStructureChecker<D, C, PC,
RequiresConstantPositiveParameter(const C & clause,const parser::ScalarIntConstantExpr & i)478 ClauseEnumSize>::RequiresConstantPositiveParameter(const C &clause,
479 const parser::ScalarIntConstantExpr &i) {
480 if (const auto v{GetIntValue(i)}) {
481 if (*v <= 0) {
482 context_.Say(GetContext().clauseSource,
483 "The parameter of the %s clause must be "
484 "a constant positive integer expression"_err_en_US,
485 parser::ToUpperCaseLetters(getClauseName(clause).str()));
486 }
487 }
488 }
489
490 // Check the value of the clause is a constant positive parameter.
491 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
492 void DirectiveStructureChecker<D, C, PC,
OptionalConstantPositiveParameter(const C & clause,const std::optional<parser::ScalarIntConstantExpr> & o)493 ClauseEnumSize>::OptionalConstantPositiveParameter(const C &clause,
494 const std::optional<parser::ScalarIntConstantExpr> &o) {
495 if (o != std::nullopt) {
496 RequiresConstantPositiveParameter(clause, o.value());
497 }
498 }
499
500 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
SayNotMatching(const parser::CharBlock & beginSource,const parser::CharBlock & endSource)501 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
502 const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
503 context_
504 .Say(endSource, "Unmatched %s directive"_err_en_US,
505 parser::ToUpperCaseLetters(endSource.ToString()))
506 .Attach(beginSource, "Does not match directive"_en_US);
507 }
508
509 // Check the value of the clause is a positive parameter.
510 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
511 void DirectiveStructureChecker<D, C, PC,
RequiresPositiveParameter(const C & clause,const parser::ScalarIntExpr & i,llvm::StringRef paramName)512 ClauseEnumSize>::RequiresPositiveParameter(const C &clause,
513 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
514 if (const auto v{GetIntValue(i)}) {
515 if (*v <= 0) {
516 context_.Say(GetContext().clauseSource,
517 "The %s of the %s clause must be "
518 "a positive integer expression"_err_en_US,
519 paramName.str(),
520 parser::ToUpperCaseLetters(getClauseName(clause).str()));
521 }
522 }
523 }
524
525 } // namespace Fortran::semantics
526
527 #endif // FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
528