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