xref: /llvm-project/flang/lib/Semantics/resolve-labels.cpp (revision 64ab3302d5a130c00b66a6957b2e7f0c9b9c537d) 
1 //===-- lib/Semantics/resolve-labels.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 "resolve-labels.h"
10 #include "flang/Common/enum-set.h"
11 #include "flang/Common/template.h"
12 #include "flang/Parser/parse-tree-visitor.h"
13 #include "flang/Semantics/semantics.h"
14 #include <cctype>
15 #include <cstdarg>
16 #include <type_traits>
17 
18 namespace Fortran::semantics {
19 
20 using namespace parser::literals;
21 
22 ENUM_CLASS(
23     TargetStatementEnum, Do, Branch, Format, CompatibleDo, CompatibleBranch)
24 using LabeledStmtClassificationSet =
25     common::EnumSet<TargetStatementEnum, TargetStatementEnum_enumSize>;
26 
27 using IndexList = std::vector<std::pair<parser::CharBlock, parser::CharBlock>>;
28 // A ProxyForScope is an integral proxy for a Fortran scope. This is required
29 // because the parse tree does not actually have the scopes required.
30 using ProxyForScope = unsigned;
31 struct LabeledStatementInfoTuplePOD {
32   ProxyForScope proxyForScope;
33   parser::CharBlock parserCharBlock;
34   LabeledStmtClassificationSet labeledStmtClassificationSet;
35   bool isExecutableConstructEndStmt;
36 };
37 using TargetStmtMap = std::map<parser::Label, LabeledStatementInfoTuplePOD>;
38 struct SourceStatementInfoTuplePOD {
39   SourceStatementInfoTuplePOD(const parser::Label &parserLabel,
40       const ProxyForScope &proxyForScope,
41       const parser::CharBlock &parserCharBlock)
42     : parserLabel{parserLabel}, proxyForScope{proxyForScope},
43       parserCharBlock{parserCharBlock} {}
44   parser::Label parserLabel;
45   ProxyForScope proxyForScope;
46   parser::CharBlock parserCharBlock;
47 };
48 using SourceStmtList = std::vector<SourceStatementInfoTuplePOD>;
49 enum class Legality { never, always, formerly };
50 
51 bool HasScope(ProxyForScope scope) { return scope != ProxyForScope{0u}; }
52 
53 // F18:R1131
54 template<typename A>
55 constexpr Legality IsLegalDoTerm(const parser::Statement<A> &) {
56   if (std::is_same_v<A, common::Indirection<parser::EndDoStmt>> ||
57       std::is_same_v<A, parser::EndDoStmt>) {
58     return Legality::always;
59   } else if (std::is_same_v<A, parser::EndForallStmt> ||
60       std::is_same_v<A, parser::EndWhereStmt>) {
61     // Executable construct end statements are also supported as
62     // an extension but they need special care because the associated
63     // construct create there own scope.
64     return Legality::formerly;
65   } else {
66     return Legality::never;
67   }
68 }
69 
70 constexpr Legality IsLegalDoTerm(
71     const parser::Statement<parser::ActionStmt> &actionStmt) {
72   if (std::holds_alternative<parser::ContinueStmt>(actionStmt.statement.u)) {
73     // See F08:C816
74     return Legality::always;
75   } else if (!(std::holds_alternative<
76                    common::Indirection<parser::ArithmeticIfStmt>>(
77                    actionStmt.statement.u) ||
78                  std::holds_alternative<common::Indirection<parser::CycleStmt>>(
79                      actionStmt.statement.u) ||
80                  std::holds_alternative<common::Indirection<parser::ExitStmt>>(
81                      actionStmt.statement.u) ||
82                  std::holds_alternative<common::Indirection<parser::StopStmt>>(
83                      actionStmt.statement.u) ||
84                  std::holds_alternative<common::Indirection<parser::GotoStmt>>(
85                      actionStmt.statement.u) ||
86                  std::holds_alternative<
87                      common::Indirection<parser::ReturnStmt>>(
88                      actionStmt.statement.u))) {
89     return Legality::formerly;
90   } else {
91     return Legality::never;
92   }
93 }
94 
95 template<typename A> constexpr bool IsFormat(const parser::Statement<A> &) {
96   return std::is_same_v<A, common::Indirection<parser::FormatStmt>>;
97 }
98 
99 template<typename A>
100 constexpr Legality IsLegalBranchTarget(const parser::Statement<A> &) {
101   if (std::is_same_v<A, parser::ActionStmt> ||
102       std::is_same_v<A, parser::AssociateStmt> ||
103       std::is_same_v<A, parser::EndAssociateStmt> ||
104       std::is_same_v<A, parser::IfThenStmt> ||
105       std::is_same_v<A, parser::EndIfStmt> ||
106       std::is_same_v<A, parser::SelectCaseStmt> ||
107       std::is_same_v<A, parser::EndSelectStmt> ||
108       std::is_same_v<A, parser::SelectRankStmt> ||
109       std::is_same_v<A, parser::SelectTypeStmt> ||
110       std::is_same_v<A, common::Indirection<parser::LabelDoStmt>> ||
111       std::is_same_v<A, parser::NonLabelDoStmt> ||
112       std::is_same_v<A, parser::EndDoStmt> ||
113       std::is_same_v<A, common::Indirection<parser::EndDoStmt>> ||
114       std::is_same_v<A, parser::BlockStmt> ||
115       std::is_same_v<A, parser::EndBlockStmt> ||
116       std::is_same_v<A, parser::CriticalStmt> ||
117       std::is_same_v<A, parser::EndCriticalStmt> ||
118       std::is_same_v<A, parser::ForallConstructStmt> ||
119       std::is_same_v<A, parser::ForallStmt> ||
120       std::is_same_v<A, parser::WhereConstructStmt> ||
121       std::is_same_v<A, parser::EndFunctionStmt> ||
122       std::is_same_v<A, parser::EndMpSubprogramStmt> ||
123       std::is_same_v<A, parser::EndProgramStmt> ||
124       std::is_same_v<A, parser::EndSubroutineStmt>) {
125     return Legality::always;
126   } else {
127     return Legality::never;
128   }
129 }
130 
131 template<typename A>
132 constexpr LabeledStmtClassificationSet ConstructBranchTargetFlags(
133     const parser::Statement<A> &statement) {
134   LabeledStmtClassificationSet labeledStmtClassificationSet{};
135   if (IsLegalDoTerm(statement) == Legality::always) {
136     labeledStmtClassificationSet.set(TargetStatementEnum::Do);
137   } else if (IsLegalDoTerm(statement) == Legality::formerly) {
138     labeledStmtClassificationSet.set(TargetStatementEnum::CompatibleDo);
139   }
140   if (IsLegalBranchTarget(statement) == Legality::always) {
141     labeledStmtClassificationSet.set(TargetStatementEnum::Branch);
142   } else if (IsLegalBranchTarget(statement) == Legality::formerly) {
143     labeledStmtClassificationSet.set(TargetStatementEnum::CompatibleBranch);
144   }
145   if (IsFormat(statement)) {
146     labeledStmtClassificationSet.set(TargetStatementEnum::Format);
147   }
148   return labeledStmtClassificationSet;
149 }
150 
151 static unsigned SayLabel(parser::Label label) {
152   return static_cast<unsigned>(label);
153 }
154 
155 struct UnitAnalysis {
156   UnitAnalysis() { scopeModel.push_back(0); }
157   UnitAnalysis(UnitAnalysis &&that)
158     : doStmtSources{std::move(that.doStmtSources)},
159       formatStmtSources{std::move(that.formatStmtSources)},
160       otherStmtSources{std::move(that.otherStmtSources)},
161       targetStmts{std::move(that.targetStmts)}, scopeModel{std::move(
162                                                     that.scopeModel)} {}
163 
164   SourceStmtList doStmtSources;
165   SourceStmtList formatStmtSources;
166   SourceStmtList otherStmtSources;
167   TargetStmtMap targetStmts;
168   std::vector<ProxyForScope> scopeModel;
169 };
170 
171 // Some parse tree record for statements simply wrap construct names;
172 // others include them as tuple components.  Given a statement,
173 // return a pointer to its name if it has one.
174 template<typename A>
175 const parser::CharBlock *GetStmtName(const parser::Statement<A> &stmt) {
176   const std::optional<parser::Name> *name{nullptr};
177   if constexpr (WrapperTrait<A>) {
178     if constexpr (std::is_same_v<decltype(A::v), parser::Name>) {
179       return &stmt.statement.v.source;
180     } else {
181       name = &stmt.statement.v;
182     }
183   } else if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
184       std::is_same_v<A, parser::SelectTypeStmt>) {
185     name = &std::get<0>(stmt.statement.t);
186   } else if constexpr (common::HasMember<parser::Name,
187                            decltype(stmt.statement.t)>) {
188     return &std::get<parser::Name>(stmt.statement.t).source;
189   } else {
190     name = &std::get<std::optional<parser::Name>>(stmt.statement.t);
191   }
192   if (name && *name) {
193     return &(*name)->source;
194   }
195   return nullptr;
196 }
197 
198 using ExecutableConstructEndStmts = std::tuple<parser::EndIfStmt,
199     parser::EndDoStmt, parser::EndSelectStmt, parser::EndChangeTeamStmt,
200     parser::EndBlockStmt, parser::EndCriticalStmt, parser::EndAssociateStmt>;
201 
202 template<typename A>
203 static constexpr bool IsExecutableConstructEndStmt{
204     common::HasMember<A, ExecutableConstructEndStmts>};
205 
206 class ParseTreeAnalyzer {
207 public:
208   ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default;
209   ParseTreeAnalyzer(SemanticsContext &context) : context_{context} {}
210 
211   template<typename A> constexpr bool Pre(const A &) { return true; }
212   template<typename A> constexpr void Post(const A &) {}
213 
214   template<typename A> bool Pre(const parser::Statement<A> &statement) {
215     currentPosition_ = statement.source;
216     if (statement.label) {
217       auto label{statement.label.value()};
218       auto targetFlags{ConstructBranchTargetFlags(statement)};
219       if constexpr (std::is_same_v<A, parser::AssociateStmt> ||
220           std::is_same_v<A, parser::BlockStmt> ||
221           std::is_same_v<A, parser::ChangeTeamStmt> ||
222           std::is_same_v<A, parser::CriticalStmt> ||
223           std::is_same_v<A, parser::NonLabelDoStmt> ||
224           std::is_same_v<A, parser::IfThenStmt> ||
225           std::is_same_v<A, parser::SelectCaseStmt> ||
226           std::is_same_v<A, parser::SelectRankStmt> ||
227           std::is_same_v<A, parser::SelectTypeStmt>) {
228         constexpr bool useParent{true};
229         AddTargetLabelDefinition(
230             useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
231       } else {
232         constexpr bool useParent{false};
233         AddTargetLabelDefinition(
234             useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
235       }
236     }
237     return true;
238   }
239 
240   // see 11.1.1
241   bool Pre(const parser::ProgramUnit &) { return InitializeNewScopeContext(); }
242   bool Pre(const parser::InternalSubprogram &) {
243     return InitializeNewScopeContext();
244   }
245   bool Pre(const parser::ModuleSubprogram &) {
246     return InitializeNewScopeContext();
247   }
248   bool Pre(const parser::AssociateConstruct &associateConstruct) {
249     return PushConstructName(associateConstruct);
250   }
251   bool Pre(const parser::BlockConstruct &blockConstruct) {
252     return PushConstructName(blockConstruct);
253   }
254   bool Pre(const parser::ChangeTeamConstruct &changeTeamConstruct) {
255     return PushConstructName(changeTeamConstruct);
256   }
257   bool Pre(const parser::CriticalConstruct &criticalConstruct) {
258     return PushConstructName(criticalConstruct);
259   }
260   bool Pre(const parser::DoConstruct &doConstruct) {
261     return PushConstructName(doConstruct);
262   }
263   bool Pre(const parser::IfConstruct &ifConstruct) {
264     return PushConstructName(ifConstruct);
265   }
266   bool Pre(const parser::IfConstruct::ElseIfBlock &) {
267     return SwitchToNewScope();
268   }
269   bool Pre(const parser::IfConstruct::ElseBlock &) {
270     return SwitchToNewScope();
271   }
272   bool Pre(const parser::CaseConstruct &caseConstruct) {
273     return PushConstructName(caseConstruct);
274   }
275   bool Pre(const parser::CaseConstruct::Case &) { return SwitchToNewScope(); }
276   bool Pre(const parser::SelectRankConstruct &selectRankConstruct) {
277     return PushConstructName(selectRankConstruct);
278   }
279   bool Pre(const parser::SelectRankConstruct::RankCase &) {
280     return SwitchToNewScope();
281   }
282   bool Pre(const parser::SelectTypeConstruct &selectTypeConstruct) {
283     return PushConstructName(selectTypeConstruct);
284   }
285   bool Pre(const parser::SelectTypeConstruct::TypeCase &) {
286     return SwitchToNewScope();
287   }
288   bool Pre(const parser::WhereConstruct &whereConstruct) {
289     return PushConstructNameWithoutBlock(whereConstruct);
290   }
291   bool Pre(const parser::ForallConstruct &forallConstruct) {
292     return PushConstructNameWithoutBlock(forallConstruct);
293   }
294 
295   void Post(const parser::AssociateConstruct &associateConstruct) {
296     PopConstructName(associateConstruct);
297   }
298   void Post(const parser::BlockConstruct &blockConstruct) {
299     PopConstructName(blockConstruct);
300   }
301   void Post(const parser::ChangeTeamConstruct &changeTeamConstruct) {
302     PopConstructName(changeTeamConstruct);
303   }
304   void Post(const parser::CriticalConstruct &criticalConstruct) {
305     PopConstructName(criticalConstruct);
306   }
307   void Post(const parser::DoConstruct &doConstruct) {
308     PopConstructName(doConstruct);
309   }
310   void Post(const parser::IfConstruct &ifConstruct) {
311     PopConstructName(ifConstruct);
312   }
313   void Post(const parser::CaseConstruct &caseConstruct) {
314     PopConstructName(caseConstruct);
315   }
316   void Post(const parser::SelectRankConstruct &selectRankConstruct) {
317     PopConstructName(selectRankConstruct);
318   }
319   void Post(const parser::SelectTypeConstruct &selectTypeConstruct) {
320     PopConstructName(selectTypeConstruct);
321   }
322 
323   void Post(const parser::WhereConstruct &whereConstruct) {
324     PopConstructNameWithoutBlock(whereConstruct);
325   }
326   void Post(const parser::ForallConstruct &forallConstruct) {
327     PopConstructNameWithoutBlock(forallConstruct);
328   }
329 
330   // Checks for missing or mismatching names on various constructs (e.g., IF)
331   // and their intermediate or terminal statements that allow optional
332   // construct names(e.g., ELSE).  When an optional construct name is present,
333   // the construct as a whole must have a name that matches.
334   template<typename FIRST, typename CONSTRUCT, typename STMT>
335   void CheckOptionalName(const char *constructTag, const CONSTRUCT &a,
336       const parser::Statement<STMT> &stmt) {
337     if (const parser::CharBlock * name{GetStmtName(stmt)}) {
338       const auto &firstStmt{std::get<parser::Statement<FIRST>>(a.t)};
339       if (const parser::CharBlock * firstName{GetStmtName(firstStmt)}) {
340         if (*firstName != *name) {
341           context_
342               .Say(*name,
343                   parser::MessageFormattedText{
344                       "%s name mismatch"_err_en_US, constructTag})
345               .Attach(*firstName, "should be"_en_US);
346         }
347       } else {
348         context_
349             .Say(*name,
350                 parser::MessageFormattedText{
351                     "%s name not allowed"_err_en_US, constructTag})
352             .Attach(firstStmt.source, "in unnamed %s"_en_US, constructTag);
353       }
354     }
355   }
356 
357   // C1414
358   void Post(const parser::BlockData &blockData) {
359     CheckOptionalName<parser::BlockDataStmt>("BLOCK DATA subprogram", blockData,
360         std::get<parser::Statement<parser::EndBlockDataStmt>>(blockData.t));
361   }
362 
363   // C1564
364   void Post(const parser::FunctionSubprogram &functionSubprogram) {
365     CheckOptionalName<parser::FunctionStmt>("FUNCTION", functionSubprogram,
366         std::get<parser::Statement<parser::EndFunctionStmt>>(
367             functionSubprogram.t));
368   }
369   void Post(const parser::InterfaceBlock &interfaceBlock) {
370     auto &interfaceStmt{
371         std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t)};
372     if (const auto *optionalGenericSpecPointer{
373             std::get_if<std::optional<parser::GenericSpec>>(
374                 &interfaceStmt.statement.u)}) {
375       if (*optionalGenericSpecPointer) {
376         if (const auto *namePointer{
377                 std::get_if<parser::Name>(&(*optionalGenericSpecPointer)->u)}) {
378           auto &optionalGenericSpec{
379               std::get<parser::Statement<parser::EndInterfaceStmt>>(
380                   interfaceBlock.t)
381                   .statement.v};
382           if (optionalGenericSpec) {
383             if (const auto *otherPointer{
384                     std::get_if<parser::Name>(&optionalGenericSpec->u)}) {
385               if (namePointer->source != otherPointer->source) {
386                 context_
387                     .Say(currentPosition_,
388                         parser::MessageFormattedText{
389                             "INTERFACE generic-name (%s) mismatch"_en_US,
390                             namePointer->source})
391                     .Attach(interfaceStmt.source, "mismatched INTERFACE"_en_US);
392               }
393             }
394           }
395         }
396       }
397     }
398   }
399 
400   // C1402
401   void Post(const parser::Module &module) {
402     CheckOptionalName<parser::ModuleStmt>("MODULE", module,
403         std::get<parser::Statement<parser::EndModuleStmt>>(module.t));
404   }
405 
406   // C1569
407   void Post(const parser::SeparateModuleSubprogram &separateModuleSubprogram) {
408     CheckOptionalName<parser::MpSubprogramStmt>("MODULE PROCEDURE",
409         separateModuleSubprogram,
410         std::get<parser::Statement<parser::EndMpSubprogramStmt>>(
411             separateModuleSubprogram.t));
412   }
413 
414   // C1401
415   void Post(const parser::MainProgram &mainProgram) {
416     if (const parser::CharBlock *
417         endName{GetStmtName(std::get<parser::Statement<parser::EndProgramStmt>>(
418             mainProgram.t))}) {
419       if (const auto &program{
420               std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(
421                   mainProgram.t)}) {
422         if (*endName != program->statement.v.source) {
423           context_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
424               .Attach(program->statement.v.source, "should be"_en_US);
425         }
426       } else {
427         context_.Say(*endName,
428             parser::MessageFormattedText{
429                 "END PROGRAM has name without PROGRAM statement"_err_en_US});
430       }
431     }
432   }
433 
434   // C1413
435   void Post(const parser::Submodule &submodule) {
436     CheckOptionalName<parser::SubmoduleStmt>("SUBMODULE", submodule,
437         std::get<parser::Statement<parser::EndSubmoduleStmt>>(submodule.t));
438   }
439 
440   // C1567
441   void Post(const parser::SubroutineSubprogram &subroutineSubprogram) {
442     CheckOptionalName<parser::SubroutineStmt>("SUBROUTINE",
443         subroutineSubprogram,
444         std::get<parser::Statement<parser::EndSubroutineStmt>>(
445             subroutineSubprogram.t));
446   }
447 
448   // C739
449   void Post(const parser::DerivedTypeDef &derivedTypeDef) {
450     CheckOptionalName<parser::DerivedTypeStmt>("derived type definition",
451         derivedTypeDef,
452         std::get<parser::Statement<parser::EndTypeStmt>>(derivedTypeDef.t));
453   }
454 
455   void Post(const parser::LabelDoStmt &labelDoStmt) {
456     AddLabelReferenceFromDoStmt(std::get<parser::Label>(labelDoStmt.t));
457   }
458   void Post(const parser::GotoStmt &gotoStmt) { AddLabelReference(gotoStmt.v); }
459   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
460     AddLabelReference(std::get<std::list<parser::Label>>(computedGotoStmt.t));
461   }
462   void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
463     AddLabelReference(std::get<1>(arithmeticIfStmt.t));
464     AddLabelReference(std::get<2>(arithmeticIfStmt.t));
465     AddLabelReference(std::get<3>(arithmeticIfStmt.t));
466   }
467   void Post(const parser::AssignStmt &assignStmt) {
468     AddLabelReference(std::get<parser::Label>(assignStmt.t));
469   }
470   void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
471     AddLabelReference(std::get<std::list<parser::Label>>(assignedGotoStmt.t));
472   }
473   void Post(const parser::AltReturnSpec &altReturnSpec) {
474     AddLabelReference(altReturnSpec.v);
475   }
476 
477   void Post(const parser::ErrLabel &errLabel) { AddLabelReference(errLabel.v); }
478   void Post(const parser::EndLabel &endLabel) { AddLabelReference(endLabel.v); }
479   void Post(const parser::EorLabel &eorLabel) { AddLabelReference(eorLabel.v); }
480   void Post(const parser::Format &format) {
481     if (const auto *labelPointer{std::get_if<parser::Label>(&format.u)}) {
482       AddLabelReferenceToFormatStmt(*labelPointer);
483     }
484   }
485   void Post(const parser::CycleStmt &cycleStmt) {
486     if (cycleStmt.v) {
487       CheckLabelContext("CYCLE", cycleStmt.v->source);
488     }
489   }
490   void Post(const parser::ExitStmt &exitStmt) {
491     if (exitStmt.v) {
492       CheckLabelContext("EXIT", exitStmt.v->source);
493     }
494   }
495 
496   const std::vector<UnitAnalysis> &ProgramUnits() const {
497     return programUnits_;
498   }
499   SemanticsContext &ErrorHandler() { return context_; }
500 
501 private:
502   bool PushSubscope() {
503     programUnits_.back().scopeModel.push_back(currentScope_);
504     currentScope_ = programUnits_.back().scopeModel.size() - 1;
505     return true;
506   }
507   bool InitializeNewScopeContext() {
508     programUnits_.emplace_back(UnitAnalysis{});
509     currentScope_ = 0u;
510     return PushSubscope();
511   }
512   void PopScope() {
513     currentScope_ = programUnits_.back().scopeModel[currentScope_];
514   }
515   ProxyForScope ParentScope() {
516     return programUnits_.back().scopeModel[currentScope_];
517   }
518   bool SwitchToNewScope() {
519     PopScope();
520     return PushSubscope();
521   }
522 
523   template<typename A> bool PushConstructName(const A &a) {
524     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
525     if (optionalName) {
526       constructNames_.emplace_back(optionalName->ToString());
527     }
528     return PushSubscope();
529   }
530   bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
531     const auto &optionalName{
532         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
533             .statement.v};
534     if (optionalName) {
535       constructNames_.emplace_back(optionalName->ToString());
536     }
537     return PushSubscope();
538   }
539   template<typename A> bool PushConstructNameWithoutBlock(const A &a) {
540     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
541     if (optionalName) {
542       constructNames_.emplace_back(optionalName->ToString());
543     }
544     return true;
545   }
546 
547   template<typename A> void PopConstructNameWithoutBlock(const A &a) {
548     CheckName(a);
549     PopConstructNameIfPresent(a);
550   }
551   template<typename A> void PopConstructNameIfPresent(const A &a) {
552     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
553     if (optionalName) {
554       constructNames_.pop_back();
555     }
556   }
557   void PopConstructNameIfPresent(const parser::BlockConstruct &blockConstruct) {
558     const auto &optionalName{
559         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
560             .statement.v};
561     if (optionalName) {
562       constructNames_.pop_back();
563     }
564   }
565 
566   template<typename A> void PopConstructName(const A &a) {
567     CheckName(a);
568     PopScope();
569     PopConstructNameIfPresent(a);
570   }
571 
572   template<typename FIRST, typename CASEBLOCK, typename CASE,
573       typename CONSTRUCT>
574   void CheckSelectNames(const char *tag, const CONSTRUCT &construct) {
575     CheckEndName<FIRST, parser::EndSelectStmt>(tag, construct);
576     for (const auto &inner : std::get<std::list<CASEBLOCK>>(construct.t)) {
577       CheckOptionalName<FIRST>(
578           tag, construct, std::get<parser::Statement<CASE>>(inner.t));
579     }
580   }
581 
582   // C1144
583   void PopConstructName(const parser::CaseConstruct &caseConstruct) {
584     CheckSelectNames<parser::SelectCaseStmt, parser::CaseConstruct::Case,
585         parser::CaseStmt>("SELECT CASE", caseConstruct);
586     PopScope();
587     PopConstructNameIfPresent(caseConstruct);
588   }
589 
590   // C1154, C1156
591   void PopConstructName(
592       const parser::SelectRankConstruct &selectRankConstruct) {
593     CheckSelectNames<parser::SelectRankStmt,
594         parser::SelectRankConstruct::RankCase, parser::SelectRankCaseStmt>(
595         "SELECT RANK", selectRankConstruct);
596     PopScope();
597     PopConstructNameIfPresent(selectRankConstruct);
598   }
599 
600   // C1165
601   void PopConstructName(
602       const parser::SelectTypeConstruct &selectTypeConstruct) {
603     CheckSelectNames<parser::SelectTypeStmt,
604         parser::SelectTypeConstruct::TypeCase, parser::TypeGuardStmt>(
605         "SELECT TYPE", selectTypeConstruct);
606     PopScope();
607     PopConstructNameIfPresent(selectTypeConstruct);
608   }
609 
610   // Checks for missing or mismatching names on various constructs (e.g., BLOCK)
611   // and their END statements.  Both names must be present if either one is.
612   template<typename FIRST, typename END, typename CONSTRUCT>
613   void CheckEndName(const char *constructTag, const CONSTRUCT &a) {
614     const auto &constructStmt{std::get<parser::Statement<FIRST>>(a.t)};
615     const auto &endStmt{std::get<parser::Statement<END>>(a.t)};
616     const parser::CharBlock *endName{GetStmtName(endStmt)};
617     if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
618       if (endName) {
619         if (*constructName != *endName) {
620           context_
621               .Say(*endName,
622                   parser::MessageFormattedText{
623                       "%s construct name mismatch"_err_en_US, constructTag})
624               .Attach(*constructName, "should be"_en_US);
625         }
626       } else {
627         context_
628             .Say(endStmt.source,
629                 parser::MessageFormattedText{
630                     "%s construct name required but missing"_err_en_US,
631                     constructTag})
632             .Attach(*constructName, "should be"_en_US);
633       }
634     } else if (endName) {
635       context_
636           .Say(*endName,
637               parser::MessageFormattedText{
638                   "%s construct name unexpected"_err_en_US, constructTag})
639           .Attach(
640               constructStmt.source, "unnamed %s statement"_en_US, constructTag);
641     }
642   }
643 
644   // C1106
645   void CheckName(const parser::AssociateConstruct &associateConstruct) {
646     CheckEndName<parser::AssociateStmt, parser::EndAssociateStmt>(
647         "ASSOCIATE", associateConstruct);
648   }
649   // C1117
650   void CheckName(const parser::CriticalConstruct &criticalConstruct) {
651     CheckEndName<parser::CriticalStmt, parser::EndCriticalStmt>(
652         "CRITICAL", criticalConstruct);
653   }
654   // C1131
655   void CheckName(const parser::DoConstruct &doConstruct) {
656     CheckEndName<parser::NonLabelDoStmt, parser::EndDoStmt>("DO", doConstruct);
657   }
658   // C1035
659   void CheckName(const parser::ForallConstruct &forallConstruct) {
660     CheckEndName<parser::ForallConstructStmt, parser::EndForallStmt>(
661         "FORALL", forallConstruct);
662   }
663 
664   // C1109
665   void CheckName(const parser::BlockConstruct &blockConstruct) {
666     CheckEndName<parser::BlockStmt, parser::EndBlockStmt>(
667         "BLOCK", blockConstruct);
668   }
669   // C1112
670   void CheckName(const parser::ChangeTeamConstruct &changeTeamConstruct) {
671     CheckEndName<parser::ChangeTeamStmt, parser::EndChangeTeamStmt>(
672         "CHANGE TEAM", changeTeamConstruct);
673   }
674 
675   // C1142
676   void CheckName(const parser::IfConstruct &ifConstruct) {
677     CheckEndName<parser::IfThenStmt, parser::EndIfStmt>("IF", ifConstruct);
678     for (const auto &elseIfBlock :
679         std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
680       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
681           std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t));
682     }
683     if (const auto &elseBlock{
684             std::get<std::optional<parser::IfConstruct::ElseBlock>>(
685                 ifConstruct.t)}) {
686       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
687           std::get<parser::Statement<parser::ElseStmt>>(elseBlock->t));
688     }
689   }
690 
691   // C1033
692   void CheckName(const parser::WhereConstruct &whereConstruct) {
693     CheckEndName<parser::WhereConstructStmt, parser::EndWhereStmt>(
694         "WHERE", whereConstruct);
695     for (const auto &maskedElsewhere :
696         std::get<std::list<parser::WhereConstruct::MaskedElsewhere>>(
697             whereConstruct.t)) {
698       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
699           whereConstruct,
700           std::get<parser::Statement<parser::MaskedElsewhereStmt>>(
701               maskedElsewhere.t));
702     }
703     if (const auto &elsewhere{
704             std::get<std::optional<parser::WhereConstruct::Elsewhere>>(
705                 whereConstruct.t)}) {
706       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
707           whereConstruct,
708           std::get<parser::Statement<parser::ElsewhereStmt>>(elsewhere->t));
709     }
710   }
711 
712   // C1134, C1166
713   void CheckLabelContext(
714       const char *const stmtString, const parser::CharBlock &constructName) {
715     const auto iter{std::find(constructNames_.crbegin(),
716         constructNames_.crend(), constructName.ToString())};
717     if (iter == constructNames_.crend()) {
718       context_.Say(constructName,
719           parser::MessageFormattedText{
720               "%s construct-name is not in scope"_err_en_US, stmtString});
721     }
722   }
723 
724   // 6.2.5, paragraph 2
725   void CheckLabelInRange(parser::Label label) {
726     if (label < 1 || label > 99999) {
727       context_.Say(currentPosition_,
728           parser::MessageFormattedText{
729               "label '%u' is out of range"_err_en_US, SayLabel(label)});
730     }
731   }
732 
733   // 6.2.5., paragraph 2
734   void AddTargetLabelDefinition(bool useParent, parser::Label label,
735       LabeledStmtClassificationSet labeledStmtClassificationSet,
736       bool isExecutableConstructEndStmt) {
737     CheckLabelInRange(label);
738     const auto pair{programUnits_.back().targetStmts.emplace(label,
739         LabeledStatementInfoTuplePOD{
740             (useParent ? ParentScope() : currentScope_), currentPosition_,
741             labeledStmtClassificationSet, isExecutableConstructEndStmt})};
742     if (!pair.second) {
743       context_.Say(currentPosition_,
744           parser::MessageFormattedText{
745               "label '%u' is not distinct"_err_en_US, SayLabel(label)});
746     }
747   }
748 
749   void AddLabelReferenceFromDoStmt(parser::Label label) {
750     CheckLabelInRange(label);
751     programUnits_.back().doStmtSources.emplace_back(
752         label, currentScope_, currentPosition_);
753   }
754 
755   void AddLabelReferenceToFormatStmt(parser::Label label) {
756     CheckLabelInRange(label);
757     programUnits_.back().formatStmtSources.emplace_back(
758         label, currentScope_, currentPosition_);
759   }
760 
761   void AddLabelReference(parser::Label label) {
762     CheckLabelInRange(label);
763     programUnits_.back().otherStmtSources.emplace_back(
764         label, currentScope_, currentPosition_);
765   }
766 
767   void AddLabelReference(const std::list<parser::Label> &labels) {
768     for (const parser::Label &label : labels) {
769       AddLabelReference(label);
770     }
771   }
772 
773   std::vector<UnitAnalysis> programUnits_;
774   SemanticsContext &context_;
775   parser::CharBlock currentPosition_{nullptr};
776   ProxyForScope currentScope_;
777   std::vector<std::string> constructNames_;
778 };
779 
780 bool InInclusiveScope(const std::vector<ProxyForScope> &scopes,
781     ProxyForScope tail, ProxyForScope head) {
782   for (; tail != head; tail = scopes[tail]) {
783     if (!HasScope(tail)) {
784       return false;
785     }
786   }
787   return true;
788 }
789 
790 ParseTreeAnalyzer LabelAnalysis(
791     SemanticsContext &context, const parser::Program &program) {
792   ParseTreeAnalyzer analysis{context};
793   Walk(program, analysis);
794   return analysis;
795 }
796 
797 bool InBody(const parser::CharBlock &position,
798     const std::pair<parser::CharBlock, parser::CharBlock> &pair) {
799   if (position.begin() >= pair.first.begin()) {
800     if (position.begin() < pair.second.end()) {
801       return true;
802     }
803   }
804   return false;
805 }
806 
807 LabeledStatementInfoTuplePOD GetLabel(
808     const TargetStmtMap &labels, const parser::Label &label) {
809   const auto iter{labels.find(label)};
810   if (iter == labels.cend()) {
811     return {0u, nullptr, LabeledStmtClassificationSet{}, false};
812   } else {
813     return iter->second;
814   }
815 }
816 
817 // 11.1.7.3
818 void CheckBranchesIntoDoBody(const SourceStmtList &branches,
819     const TargetStmtMap &labels, const IndexList &loopBodies,
820     SemanticsContext &context) {
821   for (const auto branch : branches) {
822     const auto &label{branch.parserLabel};
823     auto branchTarget{GetLabel(labels, label)};
824     if (HasScope(branchTarget.proxyForScope)) {
825       const auto &fromPosition{branch.parserCharBlock};
826       const auto &toPosition{branchTarget.parserCharBlock};
827       for (const auto &body : loopBodies) {
828         if (!InBody(fromPosition, body) && InBody(toPosition, body)) {
829           context.Say(fromPosition, "branch into loop body from outside"_en_US)
830               .Attach(body.first, "the loop branched into"_en_US);
831         }
832       }
833     }
834   }
835 }
836 
837 void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
838   for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
839     const auto &v1{*i1};
840     for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
841       const auto &v2{*i2};
842       if (v2.first.begin() < v1.second.end() &&
843           v1.second.begin() < v2.second.begin()) {
844         context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
845             .Attach(v2.first, "DO loop conflicts"_en_US);
846       }
847     }
848   }
849 }
850 
851 parser::CharBlock SkipLabel(const parser::CharBlock &position) {
852   const std::size_t maxPosition{position.size()};
853   if (maxPosition && parser::IsDecimalDigit(position[0])) {
854     std::size_t i{1l};
855     for (; (i < maxPosition) && parser::IsDecimalDigit(position[i]); ++i) {
856     }
857     for (; (i < maxPosition) && std::isspace(position[i]); ++i) {
858     }
859     return parser::CharBlock{position.begin() + i, position.end()};
860   }
861   return position;
862 }
863 
864 ProxyForScope ParentScope(
865     const std::vector<ProxyForScope> &scopes, ProxyForScope scope) {
866   return scopes[scope];
867 }
868 
869 void CheckLabelDoConstraints(const SourceStmtList &dos,
870     const SourceStmtList &branches, const TargetStmtMap &labels,
871     const std::vector<ProxyForScope> &scopes, SemanticsContext &context) {
872   IndexList loopBodies;
873   for (const auto stmt : dos) {
874     const auto &label{stmt.parserLabel};
875     const auto &scope{stmt.proxyForScope};
876     const auto &position{stmt.parserCharBlock};
877     auto doTarget{GetLabel(labels, label)};
878     if (!HasScope(doTarget.proxyForScope)) {
879       // C1133
880       context.Say(position,
881           parser::MessageFormattedText{
882               "label '%u' cannot be found"_err_en_US, SayLabel(label)});
883     } else if (doTarget.parserCharBlock.begin() < position.begin()) {
884       // R1119
885       context.Say(position,
886           parser::MessageFormattedText{
887               "label '%u' doesn't lexically follow DO stmt"_err_en_US,
888               SayLabel(label)});
889 
890     } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
891                    doTarget.labeledStmtClassificationSet.test(
892                        TargetStatementEnum::CompatibleDo)) ||
893         (doTarget.isExecutableConstructEndStmt &&
894             ParentScope(scopes, doTarget.proxyForScope) == scope)) {
895       if (context.warnOnNonstandardUsage() ||
896           context.ShouldWarn(
897               common::LanguageFeature::OldLabelDoEndStatements)) {
898         context
899             .Say(position,
900                 parser::MessageFormattedText{
901                     "A DO loop should terminate with an END DO or CONTINUE"_en_US})
902             .Attach(doTarget.parserCharBlock,
903                 "DO loop currently ends at statement:"_en_US);
904       }
905     } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
906       context.Say(position,
907           parser::MessageFormattedText{
908               "label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
909     } else if (!doTarget.labeledStmtClassificationSet.test(
910                    TargetStatementEnum::Do)) {
911       context.Say(doTarget.parserCharBlock,
912           parser::MessageFormattedText{
913               "A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
914     } else {
915       loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
916     }
917   }
918 
919   CheckBranchesIntoDoBody(branches, labels, loopBodies, context);
920   CheckDoNesting(loopBodies, context);
921 }
922 
923 // 6.2.5
924 void CheckScopeConstraints(const SourceStmtList &stmts,
925     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
926     SemanticsContext &context) {
927   for (const auto stmt : stmts) {
928     const auto &label{stmt.parserLabel};
929     const auto &scope{stmt.proxyForScope};
930     const auto &position{stmt.parserCharBlock};
931     auto target{GetLabel(labels, label)};
932     if (!HasScope(target.proxyForScope)) {
933       context.Say(position,
934           parser::MessageFormattedText{
935               "label '%u' was not found"_err_en_US, SayLabel(label)});
936     } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
937       context.Say(position,
938           parser::MessageFormattedText{
939               "label '%u' is not in scope"_en_US, SayLabel(label)});
940     }
941   }
942 }
943 
944 void CheckBranchTargetConstraints(const SourceStmtList &stmts,
945     const TargetStmtMap &labels, SemanticsContext &context) {
946   for (const auto stmt : stmts) {
947     const auto &label{stmt.parserLabel};
948     auto branchTarget{GetLabel(labels, label)};
949     if (HasScope(branchTarget.proxyForScope)) {
950       if (!branchTarget.labeledStmtClassificationSet.test(
951               TargetStatementEnum::Branch) &&
952           !branchTarget.labeledStmtClassificationSet.test(
953               TargetStatementEnum::CompatibleBranch)) {
954         context
955             .Say(branchTarget.parserCharBlock,
956                 parser::MessageFormattedText{
957                     "'%u' not a branch target"_err_en_US, SayLabel(label)})
958             .Attach(stmt.parserCharBlock,
959                 parser::MessageFormattedText{
960                     "control flow use of '%u'"_en_US, SayLabel(label)});
961       } else if (!branchTarget.labeledStmtClassificationSet.test(
962                      TargetStatementEnum::Branch)) {
963         context
964             .Say(branchTarget.parserCharBlock,
965                 parser::MessageFormattedText{
966                     "'%u' not a branch target"_en_US, SayLabel(label)})
967             .Attach(stmt.parserCharBlock,
968                 parser::MessageFormattedText{
969                     "control flow use of '%u'"_en_US, SayLabel(label)});
970       }
971     }
972   }
973 }
974 
975 void CheckBranchConstraints(const SourceStmtList &branches,
976     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
977     SemanticsContext &context) {
978   CheckScopeConstraints(branches, labels, scopes, context);
979   CheckBranchTargetConstraints(branches, labels, context);
980 }
981 
982 void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
983     const TargetStmtMap &labels, SemanticsContext &context) {
984   for (const auto stmt : stmts) {
985     const auto &label{stmt.parserLabel};
986     auto ioTarget{GetLabel(labels, label)};
987     if (HasScope(ioTarget.proxyForScope)) {
988       if (!ioTarget.labeledStmtClassificationSet.test(
989               TargetStatementEnum::Format)) {
990         context
991             .Say(ioTarget.parserCharBlock,
992                 parser::MessageFormattedText{
993                     "'%u' not a FORMAT"_err_en_US, SayLabel(label)})
994             .Attach(stmt.parserCharBlock,
995                 parser::MessageFormattedText{
996                     "data transfer use of '%u'"_en_US, SayLabel(label)});
997       }
998     }
999   }
1000 }
1001 
1002 void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
1003     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
1004     SemanticsContext &context) {
1005   CheckScopeConstraints(dataTransfers, labels, scopes, context);
1006   CheckDataXferTargetConstraints(dataTransfers, labels, context);
1007 }
1008 
1009 bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
1010   auto &context{parseTreeAnalysis.ErrorHandler()};
1011   for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
1012     const auto &dos{programUnit.doStmtSources};
1013     const auto &branches{programUnit.otherStmtSources};
1014     const auto &labels{programUnit.targetStmts};
1015     const auto &scopes{programUnit.scopeModel};
1016     CheckLabelDoConstraints(dos, branches, labels, scopes, context);
1017     CheckBranchConstraints(branches, labels, scopes, context);
1018     const auto &dataTransfers{programUnit.formatStmtSources};
1019     CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
1020   }
1021   return !context.AnyFatalError();
1022 }
1023 
1024 bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
1025   return CheckConstraints(LabelAnalysis(context, program));
1026 }
1027 }
1028