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