• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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