xref: /llvm-project/flang/lib/Semantics/resolve-labels.cpp (revision 455ed8de4f878160be9cfd17db891b326fb4a6a2) 
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::FunctionSubprogram &functionSubprogram) {
360     CheckOptionalName<parser::FunctionStmt>("FUNCTION", functionSubprogram,
361         std::get<parser::Statement<parser::EndFunctionStmt>>(
362             functionSubprogram.t));
363   }
364   void Post(const parser::InterfaceBlock &interfaceBlock) {
365     auto &interfaceStmt{
366         std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t)};
367     if (const auto *optionalGenericSpecPointer{
368             std::get_if<std::optional<parser::GenericSpec>>(
369                 &interfaceStmt.statement.u)}) {
370       if (*optionalGenericSpecPointer) {
371         if (const auto *namePointer{
372                 std::get_if<parser::Name>(&(*optionalGenericSpecPointer)->u)}) {
373           auto &optionalGenericSpec{
374               std::get<parser::Statement<parser::EndInterfaceStmt>>(
375                   interfaceBlock.t)
376                   .statement.v};
377           if (optionalGenericSpec) {
378             if (const auto *otherPointer{
379                     std::get_if<parser::Name>(&optionalGenericSpec->u)}) {
380               if (namePointer->source != otherPointer->source) {
381                 context_
382                     .Say(currentPosition_,
383                         parser::MessageFormattedText{
384                             "INTERFACE generic-name (%s) mismatch"_en_US,
385                             namePointer->source})
386                     .Attach(interfaceStmt.source, "mismatched INTERFACE"_en_US);
387               }
388             }
389           }
390         }
391       }
392     }
393   }
394 
395   // C1402
396   void Post(const parser::Module &module) {
397     CheckOptionalName<parser::ModuleStmt>("MODULE", module,
398         std::get<parser::Statement<parser::EndModuleStmt>>(module.t));
399   }
400 
401   // C1569
402   void Post(const parser::SeparateModuleSubprogram &separateModuleSubprogram) {
403     CheckOptionalName<parser::MpSubprogramStmt>("MODULE PROCEDURE",
404         separateModuleSubprogram,
405         std::get<parser::Statement<parser::EndMpSubprogramStmt>>(
406             separateModuleSubprogram.t));
407   }
408 
409   // C1401
410   void Post(const parser::MainProgram &mainProgram) {
411     if (const parser::CharBlock *
412         endName{GetStmtName(std::get<parser::Statement<parser::EndProgramStmt>>(
413             mainProgram.t))}) {
414       if (const auto &program{
415               std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(
416                   mainProgram.t)}) {
417         if (*endName != program->statement.v.source) {
418           context_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
419               .Attach(program->statement.v.source, "should be"_en_US);
420         }
421       } else {
422         context_.Say(*endName,
423             parser::MessageFormattedText{
424                 "END PROGRAM has name without PROGRAM statement"_err_en_US});
425       }
426     }
427   }
428 
429   // C1413
430   void Post(const parser::Submodule &submodule) {
431     CheckOptionalName<parser::SubmoduleStmt>("SUBMODULE", submodule,
432         std::get<parser::Statement<parser::EndSubmoduleStmt>>(submodule.t));
433   }
434 
435   // C1567
436   void Post(const parser::SubroutineSubprogram &subroutineSubprogram) {
437     CheckOptionalName<parser::SubroutineStmt>("SUBROUTINE",
438         subroutineSubprogram,
439         std::get<parser::Statement<parser::EndSubroutineStmt>>(
440             subroutineSubprogram.t));
441   }
442 
443   // C739
444   void Post(const parser::DerivedTypeDef &derivedTypeDef) {
445     CheckOptionalName<parser::DerivedTypeStmt>("derived type definition",
446         derivedTypeDef,
447         std::get<parser::Statement<parser::EndTypeStmt>>(derivedTypeDef.t));
448   }
449 
450   void Post(const parser::LabelDoStmt &labelDoStmt) {
451     AddLabelReferenceFromDoStmt(std::get<parser::Label>(labelDoStmt.t));
452   }
453   void Post(const parser::GotoStmt &gotoStmt) { AddLabelReference(gotoStmt.v); }
454   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
455     AddLabelReference(std::get<std::list<parser::Label>>(computedGotoStmt.t));
456   }
457   void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
458     AddLabelReference(std::get<1>(arithmeticIfStmt.t));
459     AddLabelReference(std::get<2>(arithmeticIfStmt.t));
460     AddLabelReference(std::get<3>(arithmeticIfStmt.t));
461   }
462   void Post(const parser::AssignStmt &assignStmt) {
463     AddLabelReferenceFromAssignStmt(std::get<parser::Label>(assignStmt.t));
464   }
465   void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
466     AddLabelReference(std::get<std::list<parser::Label>>(assignedGotoStmt.t));
467   }
468   void Post(const parser::AltReturnSpec &altReturnSpec) {
469     AddLabelReference(altReturnSpec.v);
470   }
471 
472   void Post(const parser::ErrLabel &errLabel) { AddLabelReference(errLabel.v); }
473   void Post(const parser::EndLabel &endLabel) { AddLabelReference(endLabel.v); }
474   void Post(const parser::EorLabel &eorLabel) { AddLabelReference(eorLabel.v); }
475   void Post(const parser::Format &format) {
476     if (const auto *labelPointer{std::get_if<parser::Label>(&format.u)}) {
477       AddLabelReferenceToFormatStmt(*labelPointer);
478     }
479   }
480   void Post(const parser::CycleStmt &cycleStmt) {
481     if (cycleStmt.v) {
482       CheckLabelContext("CYCLE", cycleStmt.v->source);
483     }
484   }
485   void Post(const parser::ExitStmt &exitStmt) {
486     if (exitStmt.v) {
487       CheckLabelContext("EXIT", exitStmt.v->source);
488     }
489   }
490 
491   const std::vector<UnitAnalysis> &ProgramUnits() const {
492     return programUnits_;
493   }
494   SemanticsContext &ErrorHandler() { return context_; }
495 
496 private:
497   bool PushSubscope() {
498     programUnits_.back().scopeModel.push_back(currentScope_);
499     currentScope_ = programUnits_.back().scopeModel.size() - 1;
500     return true;
501   }
502   bool InitializeNewScopeContext() {
503     programUnits_.emplace_back(UnitAnalysis{});
504     currentScope_ = 0u;
505     return PushSubscope();
506   }
507   void PopScope() {
508     currentScope_ = programUnits_.back().scopeModel[currentScope_];
509   }
510   ProxyForScope ParentScope() {
511     return programUnits_.back().scopeModel[currentScope_];
512   }
513   bool SwitchToNewScope() {
514     PopScope();
515     return PushSubscope();
516   }
517 
518   template <typename A> bool PushConstructName(const A &a) {
519     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
520     if (optionalName) {
521       constructNames_.emplace_back(optionalName->ToString());
522     }
523     return PushSubscope();
524   }
525   bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
526     const auto &optionalName{
527         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
528             .statement.v};
529     if (optionalName) {
530       constructNames_.emplace_back(optionalName->ToString());
531     }
532     return PushSubscope();
533   }
534   template <typename A> bool PushConstructNameWithoutBlock(const A &a) {
535     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
536     if (optionalName) {
537       constructNames_.emplace_back(optionalName->ToString());
538     }
539     return true;
540   }
541 
542   template <typename A> void PopConstructNameWithoutBlock(const A &a) {
543     CheckName(a);
544     PopConstructNameIfPresent(a);
545   }
546   template <typename A> void PopConstructNameIfPresent(const A &a) {
547     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
548     if (optionalName) {
549       constructNames_.pop_back();
550     }
551   }
552   void PopConstructNameIfPresent(const parser::BlockConstruct &blockConstruct) {
553     const auto &optionalName{
554         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
555             .statement.v};
556     if (optionalName) {
557       constructNames_.pop_back();
558     }
559   }
560 
561   template <typename A> void PopConstructName(const A &a) {
562     CheckName(a);
563     PopScope();
564     PopConstructNameIfPresent(a);
565   }
566 
567   template <typename FIRST, typename CASEBLOCK, typename CASE,
568       typename CONSTRUCT>
569   void CheckSelectNames(const char *tag, const CONSTRUCT &construct) {
570     CheckEndName<FIRST, parser::EndSelectStmt>(tag, construct);
571     for (const auto &inner : std::get<std::list<CASEBLOCK>>(construct.t)) {
572       CheckOptionalName<FIRST>(
573           tag, construct, std::get<parser::Statement<CASE>>(inner.t));
574     }
575   }
576 
577   // C1144
578   void PopConstructName(const parser::CaseConstruct &caseConstruct) {
579     CheckSelectNames<parser::SelectCaseStmt, parser::CaseConstruct::Case,
580         parser::CaseStmt>("SELECT CASE", caseConstruct);
581     PopScope();
582     PopConstructNameIfPresent(caseConstruct);
583   }
584 
585   // C1154, C1156
586   void PopConstructName(
587       const parser::SelectRankConstruct &selectRankConstruct) {
588     CheckSelectNames<parser::SelectRankStmt,
589         parser::SelectRankConstruct::RankCase, parser::SelectRankCaseStmt>(
590         "SELECT RANK", selectRankConstruct);
591     PopScope();
592     PopConstructNameIfPresent(selectRankConstruct);
593   }
594 
595   // C1165
596   void PopConstructName(
597       const parser::SelectTypeConstruct &selectTypeConstruct) {
598     CheckSelectNames<parser::SelectTypeStmt,
599         parser::SelectTypeConstruct::TypeCase, parser::TypeGuardStmt>(
600         "SELECT TYPE", selectTypeConstruct);
601     PopScope();
602     PopConstructNameIfPresent(selectTypeConstruct);
603   }
604 
605   // Checks for missing or mismatching names on various constructs (e.g., BLOCK)
606   // and their END statements.  Both names must be present if either one is.
607   template <typename FIRST, typename END, typename CONSTRUCT>
608   void CheckEndName(const char *constructTag, const CONSTRUCT &a) {
609     const auto &constructStmt{std::get<parser::Statement<FIRST>>(a.t)};
610     const auto &endStmt{std::get<parser::Statement<END>>(a.t)};
611     const parser::CharBlock *endName{GetStmtName(endStmt)};
612     if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
613       if (endName) {
614         if (*constructName != *endName) {
615           context_
616               .Say(*endName,
617                   parser::MessageFormattedText{
618                       "%s construct name mismatch"_err_en_US, constructTag})
619               .Attach(*constructName, "should be"_en_US);
620         }
621       } else {
622         context_
623             .Say(endStmt.source,
624                 parser::MessageFormattedText{
625                     "%s construct name required but missing"_err_en_US,
626                     constructTag})
627             .Attach(*constructName, "should be"_en_US);
628       }
629     } else if (endName) {
630       context_
631           .Say(*endName,
632               parser::MessageFormattedText{
633                   "%s construct name unexpected"_err_en_US, constructTag})
634           .Attach(
635               constructStmt.source, "unnamed %s statement"_en_US, constructTag);
636     }
637   }
638 
639   // C1106
640   void CheckName(const parser::AssociateConstruct &associateConstruct) {
641     CheckEndName<parser::AssociateStmt, parser::EndAssociateStmt>(
642         "ASSOCIATE", associateConstruct);
643   }
644   // C1117
645   void CheckName(const parser::CriticalConstruct &criticalConstruct) {
646     CheckEndName<parser::CriticalStmt, parser::EndCriticalStmt>(
647         "CRITICAL", criticalConstruct);
648   }
649   // C1131
650   void CheckName(const parser::DoConstruct &doConstruct) {
651     CheckEndName<parser::NonLabelDoStmt, parser::EndDoStmt>("DO", doConstruct);
652   }
653   // C1035
654   void CheckName(const parser::ForallConstruct &forallConstruct) {
655     CheckEndName<parser::ForallConstructStmt, parser::EndForallStmt>(
656         "FORALL", forallConstruct);
657   }
658 
659   // C1109
660   void CheckName(const parser::BlockConstruct &blockConstruct) {
661     CheckEndName<parser::BlockStmt, parser::EndBlockStmt>(
662         "BLOCK", blockConstruct);
663   }
664   // C1112
665   void CheckName(const parser::ChangeTeamConstruct &changeTeamConstruct) {
666     CheckEndName<parser::ChangeTeamStmt, parser::EndChangeTeamStmt>(
667         "CHANGE TEAM", changeTeamConstruct);
668   }
669 
670   // C1142
671   void CheckName(const parser::IfConstruct &ifConstruct) {
672     CheckEndName<parser::IfThenStmt, parser::EndIfStmt>("IF", ifConstruct);
673     for (const auto &elseIfBlock :
674         std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
675       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
676           std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t));
677     }
678     if (const auto &elseBlock{
679             std::get<std::optional<parser::IfConstruct::ElseBlock>>(
680                 ifConstruct.t)}) {
681       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
682           std::get<parser::Statement<parser::ElseStmt>>(elseBlock->t));
683     }
684   }
685 
686   // C1033
687   void CheckName(const parser::WhereConstruct &whereConstruct) {
688     CheckEndName<parser::WhereConstructStmt, parser::EndWhereStmt>(
689         "WHERE", whereConstruct);
690     for (const auto &maskedElsewhere :
691         std::get<std::list<parser::WhereConstruct::MaskedElsewhere>>(
692             whereConstruct.t)) {
693       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
694           whereConstruct,
695           std::get<parser::Statement<parser::MaskedElsewhereStmt>>(
696               maskedElsewhere.t));
697     }
698     if (const auto &elsewhere{
699             std::get<std::optional<parser::WhereConstruct::Elsewhere>>(
700                 whereConstruct.t)}) {
701       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
702           whereConstruct,
703           std::get<parser::Statement<parser::ElsewhereStmt>>(elsewhere->t));
704     }
705   }
706 
707   // C1134, C1166
708   void CheckLabelContext(
709       const char *const stmtString, const parser::CharBlock &constructName) {
710     const auto iter{std::find(constructNames_.crbegin(),
711         constructNames_.crend(), constructName.ToString())};
712     if (iter == constructNames_.crend()) {
713       context_.Say(constructName,
714           parser::MessageFormattedText{
715               "%s construct-name is not in scope"_err_en_US, stmtString});
716     }
717   }
718 
719   // 6.2.5, paragraph 2
720   void CheckLabelInRange(parser::Label label) {
721     if (label < 1 || label > 99999) {
722       context_.Say(currentPosition_,
723           parser::MessageFormattedText{
724               "Label '%u' is out of range"_err_en_US, SayLabel(label)});
725     }
726   }
727 
728   // 6.2.5., paragraph 2
729   void AddTargetLabelDefinition(bool useParent, parser::Label label,
730       LabeledStmtClassificationSet labeledStmtClassificationSet,
731       bool isExecutableConstructEndStmt) {
732     CheckLabelInRange(label);
733     const auto pair{programUnits_.back().targetStmts.emplace(label,
734         LabeledStatementInfoTuplePOD{
735             (useParent ? ParentScope() : currentScope_), currentPosition_,
736             labeledStmtClassificationSet, isExecutableConstructEndStmt})};
737     if (!pair.second) {
738       context_.Say(currentPosition_,
739           parser::MessageFormattedText{
740               "Label '%u' is not distinct"_err_en_US, SayLabel(label)});
741     }
742   }
743 
744   void AddLabelReferenceFromDoStmt(parser::Label label) {
745     CheckLabelInRange(label);
746     programUnits_.back().doStmtSources.emplace_back(
747         label, currentScope_, currentPosition_);
748   }
749 
750   void AddLabelReferenceToFormatStmt(parser::Label label) {
751     CheckLabelInRange(label);
752     programUnits_.back().formatStmtSources.emplace_back(
753         label, currentScope_, currentPosition_);
754   }
755 
756   void AddLabelReferenceFromAssignStmt(parser::Label label) {
757     CheckLabelInRange(label);
758     programUnits_.back().assignStmtSources.emplace_back(
759         label, currentScope_, currentPosition_);
760   }
761 
762   void AddLabelReference(parser::Label label) {
763     CheckLabelInRange(label);
764     programUnits_.back().otherStmtSources.emplace_back(
765         label, currentScope_, currentPosition_);
766   }
767 
768   void AddLabelReference(const std::list<parser::Label> &labels) {
769     for (const parser::Label &label : labels) {
770       AddLabelReference(label);
771     }
772   }
773 
774   std::vector<UnitAnalysis> programUnits_;
775   SemanticsContext &context_;
776   parser::CharBlock currentPosition_{nullptr};
777   ProxyForScope currentScope_;
778   std::vector<std::string> constructNames_;
779 };
780 
781 bool InInclusiveScope(const std::vector<ProxyForScope> &scopes,
782     ProxyForScope tail, ProxyForScope head) {
783   for (; tail != head; tail = scopes[tail]) {
784     if (!HasScope(tail)) {
785       return false;
786     }
787   }
788   return true;
789 }
790 
791 ParseTreeAnalyzer LabelAnalysis(
792     SemanticsContext &context, const parser::Program &program) {
793   ParseTreeAnalyzer analysis{context};
794   Walk(program, analysis);
795   return analysis;
796 }
797 
798 bool InBody(const parser::CharBlock &position,
799     const std::pair<parser::CharBlock, parser::CharBlock> &pair) {
800   if (position.begin() >= pair.first.begin()) {
801     if (position.begin() < pair.second.end()) {
802       return true;
803     }
804   }
805   return false;
806 }
807 
808 LabeledStatementInfoTuplePOD GetLabel(
809     const TargetStmtMap &labels, const parser::Label &label) {
810   const auto iter{labels.find(label)};
811   if (iter == labels.cend()) {
812     return {0u, nullptr, LabeledStmtClassificationSet{}, false};
813   } else {
814     return iter->second;
815   }
816 }
817 
818 // 11.1.7.3
819 void CheckBranchesIntoDoBody(const SourceStmtList &branches,
820     const TargetStmtMap &labels, const IndexList &loopBodies,
821     SemanticsContext &context) {
822   for (const auto &branch : branches) {
823     const auto &label{branch.parserLabel};
824     auto branchTarget{GetLabel(labels, label)};
825     if (HasScope(branchTarget.proxyForScope)) {
826       const auto &fromPosition{branch.parserCharBlock};
827       const auto &toPosition{branchTarget.parserCharBlock};
828       for (const auto &body : loopBodies) {
829         if (!InBody(fromPosition, body) && InBody(toPosition, body)) {
830           context.Say(fromPosition, "branch into loop body from outside"_en_US)
831               .Attach(body.first, "the loop branched into"_en_US);
832         }
833       }
834     }
835   }
836 }
837 
838 void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
839   for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
840     const auto &v1{*i1};
841     for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
842       const auto &v2{*i2};
843       if (v2.first.begin() < v1.second.end() &&
844           v1.second.begin() < v2.second.begin()) {
845         context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
846             .Attach(v2.first, "DO loop conflicts"_en_US);
847       }
848     }
849   }
850 }
851 
852 parser::CharBlock SkipLabel(const parser::CharBlock &position) {
853   const std::size_t maxPosition{position.size()};
854   if (maxPosition && parser::IsDecimalDigit(position[0])) {
855     std::size_t i{1l};
856     for (; (i < maxPosition) && parser::IsDecimalDigit(position[i]); ++i) {
857     }
858     for (; (i < maxPosition) && std::isspace(position[i]); ++i) {
859     }
860     return parser::CharBlock{position.begin() + i, position.end()};
861   }
862   return position;
863 }
864 
865 ProxyForScope ParentScope(
866     const std::vector<ProxyForScope> &scopes, ProxyForScope scope) {
867   return scopes[scope];
868 }
869 
870 void CheckLabelDoConstraints(const SourceStmtList &dos,
871     const SourceStmtList &branches, const TargetStmtMap &labels,
872     const std::vector<ProxyForScope> &scopes, SemanticsContext &context) {
873   IndexList loopBodies;
874   for (const auto &stmt : dos) {
875     const auto &label{stmt.parserLabel};
876     const auto &scope{stmt.proxyForScope};
877     const auto &position{stmt.parserCharBlock};
878     auto doTarget{GetLabel(labels, label)};
879     if (!HasScope(doTarget.proxyForScope)) {
880       // C1133
881       context.Say(position,
882           parser::MessageFormattedText{
883               "Label '%u' cannot be found"_err_en_US, SayLabel(label)});
884     } else if (doTarget.parserCharBlock.begin() < position.begin()) {
885       // R1119
886       context.Say(position,
887           parser::MessageFormattedText{
888               "Label '%u' doesn't lexically follow DO stmt"_err_en_US,
889               SayLabel(label)});
890 
891     } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
892                    doTarget.labeledStmtClassificationSet.test(
893                        TargetStatementEnum::CompatibleDo)) ||
894         (doTarget.isExecutableConstructEndStmt &&
895             ParentScope(scopes, doTarget.proxyForScope) == scope)) {
896       if (context.warnOnNonstandardUsage() ||
897           context.ShouldWarn(
898               common::LanguageFeature::OldLabelDoEndStatements)) {
899         context
900             .Say(position,
901                 parser::MessageFormattedText{
902                     "A DO loop should terminate with an END DO or CONTINUE"_en_US})
903             .Attach(doTarget.parserCharBlock,
904                 "DO loop currently ends at statement:"_en_US);
905       }
906     } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
907       context.Say(position,
908           parser::MessageFormattedText{
909               "Label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
910     } else if (!doTarget.labeledStmtClassificationSet.test(
911                    TargetStatementEnum::Do)) {
912       context.Say(doTarget.parserCharBlock,
913           parser::MessageFormattedText{
914               "A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
915     } else {
916       loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
917     }
918   }
919 
920   CheckBranchesIntoDoBody(branches, labels, loopBodies, context);
921   CheckDoNesting(loopBodies, context);
922 }
923 
924 // 6.2.5
925 void CheckScopeConstraints(const SourceStmtList &stmts,
926     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
927     SemanticsContext &context) {
928   for (const auto &stmt : stmts) {
929     const auto &label{stmt.parserLabel};
930     const auto &scope{stmt.proxyForScope};
931     const auto &position{stmt.parserCharBlock};
932     auto target{GetLabel(labels, label)};
933     if (!HasScope(target.proxyForScope)) {
934       context.Say(position,
935           parser::MessageFormattedText{
936               "Label '%u' was not found"_err_en_US, SayLabel(label)});
937     } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
938       context.Say(position,
939           parser::MessageFormattedText{
940               "Label '%u' is not in scope"_en_US, SayLabel(label)});
941     }
942   }
943 }
944 
945 void CheckBranchTargetConstraints(const SourceStmtList &stmts,
946     const TargetStmtMap &labels, SemanticsContext &context) {
947   for (const auto &stmt : stmts) {
948     const auto &label{stmt.parserLabel};
949     auto branchTarget{GetLabel(labels, label)};
950     if (HasScope(branchTarget.proxyForScope)) {
951       if (!branchTarget.labeledStmtClassificationSet.test(
952               TargetStatementEnum::Branch) &&
953           !branchTarget.labeledStmtClassificationSet.test(
954               TargetStatementEnum::CompatibleBranch)) { // error
955         context
956             .Say(branchTarget.parserCharBlock,
957                 parser::MessageFormattedText{
958                     "Label '%u' is not a branch target"_err_en_US,
959                     SayLabel(label)})
960             .Attach(stmt.parserCharBlock,
961                 parser::MessageFormattedText{
962                     "Control flow use of '%u'"_en_US, SayLabel(label)});
963       } else if (!branchTarget.labeledStmtClassificationSet.test(
964                      TargetStatementEnum::Branch)) { // warning
965         context
966             .Say(branchTarget.parserCharBlock,
967                 parser::MessageFormattedText{
968                     "Label '%u' is not a branch target"_en_US, SayLabel(label)})
969             .Attach(stmt.parserCharBlock,
970                 parser::MessageFormattedText{
971                     "Control flow use of '%u'"_en_US, SayLabel(label)});
972       }
973     }
974   }
975 }
976 
977 void CheckBranchConstraints(const SourceStmtList &branches,
978     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
979     SemanticsContext &context) {
980   CheckScopeConstraints(branches, labels, scopes, context);
981   CheckBranchTargetConstraints(branches, labels, context);
982 }
983 
984 void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
985     const TargetStmtMap &labels, SemanticsContext &context) {
986   for (const auto &stmt : stmts) {
987     const auto &label{stmt.parserLabel};
988     auto ioTarget{GetLabel(labels, label)};
989     if (HasScope(ioTarget.proxyForScope)) {
990       if (!ioTarget.labeledStmtClassificationSet.test(
991               TargetStatementEnum::Format)) {
992         context
993             .Say(ioTarget.parserCharBlock,
994                 parser::MessageFormattedText{
995                     "'%u' not a FORMAT"_err_en_US, SayLabel(label)})
996             .Attach(stmt.parserCharBlock,
997                 parser::MessageFormattedText{
998                     "data transfer use of '%u'"_en_US, SayLabel(label)});
999       }
1000     }
1001   }
1002 }
1003 
1004 void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
1005     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
1006     SemanticsContext &context) {
1007   CheckScopeConstraints(dataTransfers, labels, scopes, context);
1008   CheckDataXferTargetConstraints(dataTransfers, labels, context);
1009 }
1010 
1011 void CheckAssignTargetConstraints(const SourceStmtList &stmts,
1012     const TargetStmtMap &labels, SemanticsContext &context) {
1013   for (const auto &stmt : stmts) {
1014     const auto &label{stmt.parserLabel};
1015     auto target{GetLabel(labels, label)};
1016     if (HasScope(target.proxyForScope) &&
1017         !target.labeledStmtClassificationSet.test(
1018             TargetStatementEnum::Branch) &&
1019         !target.labeledStmtClassificationSet.test(
1020             TargetStatementEnum::Format)) {
1021       context
1022           .Say(target.parserCharBlock,
1023               target.labeledStmtClassificationSet.test(
1024                   TargetStatementEnum::CompatibleBranch)
1025                   ? "Label '%u' is not a branch target or FORMAT"_en_US
1026                   : "Label '%u' is not a branch target or FORMAT"_err_en_US,
1027               SayLabel(label))
1028           .Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US,
1029               SayLabel(label));
1030     }
1031   }
1032 }
1033 
1034 void CheckAssignConstraints(const SourceStmtList &assigns,
1035     const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
1036     SemanticsContext &context) {
1037   CheckScopeConstraints(assigns, labels, scopes, context);
1038   CheckAssignTargetConstraints(assigns, labels, context);
1039 }
1040 
1041 bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
1042   auto &context{parseTreeAnalysis.ErrorHandler()};
1043   for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
1044     const auto &dos{programUnit.doStmtSources};
1045     const auto &branches{programUnit.otherStmtSources};
1046     const auto &labels{programUnit.targetStmts};
1047     const auto &scopes{programUnit.scopeModel};
1048     CheckLabelDoConstraints(dos, branches, labels, scopes, context);
1049     CheckBranchConstraints(branches, labels, scopes, context);
1050     const auto &dataTransfers{programUnit.formatStmtSources};
1051     CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
1052     const auto &assigns{programUnit.assignStmtSources};
1053     CheckAssignConstraints(assigns, labels, scopes, context);
1054   }
1055   return !context.AnyFatalError();
1056 }
1057 
1058 bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
1059   return CheckConstraints(LabelAnalysis(context, program));
1060 }
1061 } // namespace Fortran::semantics
1062