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 if (statement.label.has_value()) {
46 labels_.insert(*statement.label);
47 }
48 return true;
49 }
50
Post(const parser::ReturnStmt &)51 void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); }
Post(const parser::ExitStmt & exitStmt)52 void Post(const parser::ExitStmt &exitStmt) {
53 if (const auto &exitName{exitStmt.v}) {
54 CheckConstructNameBranching("EXIT", exitName.value());
55 }
56 }
Post(const parser::StopStmt &)57 void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); }
58
labels()59 std::set<parser::Label> labels() { return labels_; }
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 std::set<parser::Label> labels_;
111 };
112
113 // Generic structure checker for directives/clauses language such as OpenMP
114 // and OpenACC.
115 // typename D is the directive enumeration.
116 // tyepname C is the clause enumeration.
117 // typename PC is the parser class defined in parse-tree.h for the clauses.
118 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
119 class DirectiveStructureChecker : public virtual BaseChecker {
120 protected:
DirectiveStructureChecker(SemanticsContext & context,std::unordered_map<D,DirectiveClauses<C,ClauseEnumSize>> directiveClausesMap)121 DirectiveStructureChecker(SemanticsContext &context,
122 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
123 directiveClausesMap)
124 : context_{context}, directiveClausesMap_(directiveClausesMap) {}
~DirectiveStructureChecker()125 virtual ~DirectiveStructureChecker() {}
126
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 std::multimap<C, const PC *> 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
SetContextClause(const PC & clause)153 void SetContextClause(const PC &clause) {
154 GetContext().clauseSource = clause.source;
155 GetContext().clause = &clause;
156 }
157
ResetPartialContext(const parser::CharBlock & source)158 void ResetPartialContext(const parser::CharBlock &source) {
159 CHECK(!dirContext_.empty());
160 SetContextDirectiveSource(source);
161 GetContext().allowedClauses = {};
162 GetContext().allowedOnceClauses = {};
163 GetContext().allowedExclusiveClauses = {};
164 GetContext().requiredClauses = {};
165 GetContext().clauseInfo = {};
166 GetContext().loopIV = {nullptr};
167 }
168
SetContextDirectiveSource(const parser::CharBlock & directive)169 void SetContextDirectiveSource(const parser::CharBlock &directive) {
170 GetContext().directiveSource = directive;
171 }
172
SetContextDirectiveEnum(D dir)173 void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
174
SetContextAllowed(const common::EnumSet<C,ClauseEnumSize> & allowed)175 void SetContextAllowed(const common::EnumSet<C, ClauseEnumSize> &allowed) {
176 GetContext().allowedClauses = allowed;
177 }
178
SetContextAllowedOnce(const common::EnumSet<C,ClauseEnumSize> & allowedOnce)179 void SetContextAllowedOnce(
180 const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
181 GetContext().allowedOnceClauses = allowedOnce;
182 }
183
SetContextAllowedExclusive(const common::EnumSet<C,ClauseEnumSize> & allowedExclusive)184 void SetContextAllowedExclusive(
185 const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
186 GetContext().allowedExclusiveClauses = allowedExclusive;
187 }
188
SetContextRequired(const common::EnumSet<C,ClauseEnumSize> & required)189 void SetContextRequired(const common::EnumSet<C, ClauseEnumSize> &required) {
190 GetContext().requiredClauses = required;
191 }
192
SetContextClauseInfo(C type)193 void SetContextClauseInfo(C type) {
194 GetContext().clauseInfo.emplace(type, GetContext().clause);
195 }
196
AddClauseToCrtContext(C type)197 void AddClauseToCrtContext(C type) {
198 GetContext().actualClauses.push_back(type);
199 }
200
FindClause(C type)201 const PC *FindClause(C type) {
202 auto it{GetContext().clauseInfo.find(type)};
203 if (it != GetContext().clauseInfo.end()) {
204 return it->second;
205 }
206 return nullptr;
207 }
208
PushContext(const parser::CharBlock & source,D dir)209 void PushContext(const parser::CharBlock &source, D dir) {
210 dirContext_.emplace_back(source, dir);
211 }
212
CurrentDirectiveIsNested()213 bool CurrentDirectiveIsNested() { return dirContext_.size() > 0; };
214
SetClauseSets(D dir)215 void SetClauseSets(D dir) {
216 dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
217 dirContext_.back().allowedOnceClauses =
218 directiveClausesMap_[dir].allowedOnce;
219 dirContext_.back().allowedExclusiveClauses =
220 directiveClausesMap_[dir].allowedExclusive;
221 dirContext_.back().requiredClauses =
222 directiveClausesMap_[dir].requiredOneOf;
223 }
PushContextAndClauseSets(const parser::CharBlock & source,D dir)224 void PushContextAndClauseSets(const parser::CharBlock &source, D dir) {
225 PushContext(source, dir);
226 SetClauseSets(dir);
227 }
228
229 void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
230
CheckMatching(const B & beginDir,const B & endDir)231 template <typename B> void CheckMatching(const B &beginDir, const B &endDir) {
232 const auto &begin{beginDir.v};
233 const auto &end{endDir.v};
234 if (begin != end) {
235 SayNotMatching(beginDir.source, endDir.source);
236 }
237 }
238 // Check illegal branching out of `Parser::Block` for `Parser::Name` based
239 // nodes (examples `Parser::ExitStmt`) along with `Parser::Label`
240 // based nodes (example `Parser::GotoStmt`).
241 void CheckNoBranching(const parser::Block &block, D directive,
242 const parser::CharBlock &directiveSource);
243
244 // Check that only clauses in set are after the specific clauses.
245 void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
246
247 void CheckRequireAtLeastOneOf();
248
249 void CheckAllowed(C clause);
250
251 void CheckAtLeastOneClause();
252
253 void CheckNotAllowedIfClause(
254 C clause, common::EnumSet<C, ClauseEnumSize> set);
255
256 std::string ContextDirectiveAsFortran();
257
258 void RequiresConstantPositiveParameter(
259 const C &clause, const parser::ScalarIntConstantExpr &i);
260
261 void RequiresPositiveParameter(const C &clause,
262 const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter");
263
264 void OptionalConstantPositiveParameter(
265 const C &clause, const std::optional<parser::ScalarIntConstantExpr> &o);
266
getClauseName(C clause)267 virtual llvm::StringRef getClauseName(C clause) { return ""; };
268
getDirectiveName(D directive)269 virtual llvm::StringRef getDirectiveName(D directive) { return ""; };
270
271 SemanticsContext &context_;
272 std::vector<DirectiveContext> dirContext_; // used as a stack
273 std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
274 directiveClausesMap_;
275
276 std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
277 };
278
279 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckNoBranching(const parser::Block & block,D directive,const parser::CharBlock & directiveSource)280 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
281 const parser::Block &block, D directive,
282 const parser::CharBlock &directiveSource) {
283 NoBranchingEnforce<D> noBranchingEnforce{
284 context_, directiveSource, directive, ContextDirectiveAsFortran()};
285 parser::Walk(block, noBranchingEnforce);
286
287 auto construct{parser::ToUpperCaseLetters(getDirectiveName(directive).str())};
288 LabelEnforce directiveLabelEnforce{context_, noBranchingEnforce.labels(),
289 directiveSource, construct.c_str()};
290 parser::Walk(block, directiveLabelEnforce);
291 }
292
293 // Check that only clauses included in the given set are present after the given
294 // clause.
295 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckOnlyAllowedAfter(C clause,common::EnumSet<C,ClauseEnumSize> set)296 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
297 C clause, common::EnumSet<C, ClauseEnumSize> set) {
298 bool enforceCheck = false;
299 for (auto cl : GetContext().actualClauses) {
300 if (cl == clause) {
301 enforceCheck = true;
302 continue;
303 } else if (enforceCheck && !set.test(cl)) {
304 auto parserClause = GetContext().clauseInfo.find(cl);
305 context_.Say(parserClause->second->source,
306 "Clause %s is not allowed after clause %s on the %s "
307 "directive"_err_en_US,
308 parser::ToUpperCaseLetters(getClauseName(cl).str()),
309 parser::ToUpperCaseLetters(getClauseName(clause).str()),
310 ContextDirectiveAsFortran());
311 }
312 }
313 }
314
315 // Check that at least one clause is attached to the directive.
316 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
317 void DirectiveStructureChecker<D, C, PC,
CheckAtLeastOneClause()318 ClauseEnumSize>::CheckAtLeastOneClause() {
319 if (GetContext().actualClauses.empty()) {
320 context_.Say(GetContext().directiveSource,
321 "At least one clause is required on the %s directive"_err_en_US,
322 ContextDirectiveAsFortran());
323 }
324 }
325
326 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
327 std::string
ClauseSetToString(const common::EnumSet<C,ClauseEnumSize> set)328 DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
329 const common::EnumSet<C, ClauseEnumSize> set) {
330 std::string list;
331 set.IterateOverMembers([&](C o) {
332 if (!list.empty())
333 list.append(", ");
334 list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
335 });
336 return list;
337 }
338
339 // Check that at least one clause in the required set is present on the
340 // directive.
341 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
342 void DirectiveStructureChecker<D, C, PC,
CheckRequireAtLeastOneOf()343 ClauseEnumSize>::CheckRequireAtLeastOneOf() {
344 if (GetContext().requiredClauses.empty())
345 return;
346 for (auto cl : GetContext().actualClauses) {
347 if (GetContext().requiredClauses.test(cl))
348 return;
349 }
350 // No clause matched in the actual clauses list
351 context_.Say(GetContext().directiveSource,
352 "At least one of %s clause must appear on the %s directive"_err_en_US,
353 ClauseSetToString(GetContext().requiredClauses),
354 ContextDirectiveAsFortran());
355 }
356
357 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
358 std::string DirectiveStructureChecker<D, C, PC,
ContextDirectiveAsFortran()359 ClauseEnumSize>::ContextDirectiveAsFortran() {
360 return parser::ToUpperCaseLetters(
361 getDirectiveName(GetContext().directive).str());
362 }
363
364 // Check that clauses present on the directive are allowed clauses.
365 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
CheckAllowed(C clause)366 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
367 C clause) {
368 if (!GetContext().allowedClauses.test(clause) &&
369 !GetContext().allowedOnceClauses.test(clause) &&
370 !GetContext().allowedExclusiveClauses.test(clause) &&
371 !GetContext().requiredClauses.test(clause)) {
372 context_.Say(GetContext().clauseSource,
373 "%s clause is not allowed on the %s directive"_err_en_US,
374 parser::ToUpperCaseLetters(getClauseName(clause).str()),
375 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
376 return;
377 }
378 if ((GetContext().allowedOnceClauses.test(clause) ||
379 GetContext().allowedExclusiveClauses.test(clause)) &&
380 FindClause(clause)) {
381 context_.Say(GetContext().clauseSource,
382 "At most one %s clause can appear on the %s directive"_err_en_US,
383 parser::ToUpperCaseLetters(getClauseName(clause).str()),
384 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
385 return;
386 }
387 if (GetContext().allowedExclusiveClauses.test(clause)) {
388 std::vector<C> others;
389 GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
390 if (FindClause(o)) {
391 others.emplace_back(o);
392 }
393 });
394 for (const auto &e : others) {
395 context_.Say(GetContext().clauseSource,
396 "%s and %s clauses are mutually exclusive and may not appear on the "
397 "same %s directive"_err_en_US,
398 parser::ToUpperCaseLetters(getClauseName(clause).str()),
399 parser::ToUpperCaseLetters(getClauseName(e).str()),
400 parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
401 }
402 if (!others.empty()) {
403 return;
404 }
405 }
406 SetContextClauseInfo(clause);
407 AddClauseToCrtContext(clause);
408 }
409
410 // Enforce restriction where clauses in the given set are not allowed if the
411 // given clause appears.
412 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
413 void DirectiveStructureChecker<D, C, PC,
CheckNotAllowedIfClause(C clause,common::EnumSet<C,ClauseEnumSize> set)414 ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
415 common::EnumSet<C, ClauseEnumSize> set) {
416 if (std::find(GetContext().actualClauses.begin(),
417 GetContext().actualClauses.end(),
418 clause) == GetContext().actualClauses.end()) {
419 return; // Clause is not present
420 }
421
422 for (auto cl : GetContext().actualClauses) {
423 if (set.test(cl)) {
424 context_.Say(GetContext().directiveSource,
425 "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
426 parser::ToUpperCaseLetters(getClauseName(cl).str()),
427 parser::ToUpperCaseLetters(getClauseName(clause).str()),
428 ContextDirectiveAsFortran());
429 }
430 }
431 }
432
433 // Check the value of the clause is a constant positive integer.
434 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
435 void DirectiveStructureChecker<D, C, PC,
RequiresConstantPositiveParameter(const C & clause,const parser::ScalarIntConstantExpr & i)436 ClauseEnumSize>::RequiresConstantPositiveParameter(const C &clause,
437 const parser::ScalarIntConstantExpr &i) {
438 if (const auto v{GetIntValue(i)}) {
439 if (*v <= 0) {
440 context_.Say(GetContext().clauseSource,
441 "The parameter of the %s clause must be "
442 "a constant positive integer expression"_err_en_US,
443 parser::ToUpperCaseLetters(getClauseName(clause).str()));
444 }
445 }
446 }
447
448 // Check the value of the clause is a constant positive parameter.
449 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
450 void DirectiveStructureChecker<D, C, PC,
OptionalConstantPositiveParameter(const C & clause,const std::optional<parser::ScalarIntConstantExpr> & o)451 ClauseEnumSize>::OptionalConstantPositiveParameter(const C &clause,
452 const std::optional<parser::ScalarIntConstantExpr> &o) {
453 if (o != std::nullopt) {
454 RequiresConstantPositiveParameter(clause, o.value());
455 }
456 }
457
458 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
SayNotMatching(const parser::CharBlock & beginSource,const parser::CharBlock & endSource)459 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
460 const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
461 context_
462 .Say(endSource, "Unmatched %s directive"_err_en_US,
463 parser::ToUpperCaseLetters(endSource.ToString()))
464 .Attach(beginSource, "Does not match directive"_en_US);
465 }
466
467 // Check the value of the clause is a positive parameter.
468 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
469 void DirectiveStructureChecker<D, C, PC,
RequiresPositiveParameter(const C & clause,const parser::ScalarIntExpr & i,llvm::StringRef paramName)470 ClauseEnumSize>::RequiresPositiveParameter(const C &clause,
471 const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
472 if (const auto v{GetIntValue(i)}) {
473 if (*v <= 0) {
474 context_.Say(GetContext().clauseSource,
475 "The %s of the %s clause must be "
476 "a positive integer expression"_err_en_US,
477 paramName.str(),
478 parser::ToUpperCaseLetters(getClauseName(clause).str()));
479 }
480 }
481 }
482
483 } // namespace Fortran::semantics
484
485 #endif // FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
486