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