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