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