xref: /llvm-project/flang/lib/Semantics/resolve-labels.cpp (revision 0f973ac783aa100cfbce1cd2c6e8a3a8f648fae7) 
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 <cstdarg>
15 #include <type_traits>
16 
17 namespace Fortran::semantics {
18 
19 using namespace parser::literals;
20 
21 ENUM_CLASS(
22     TargetStatementEnum, Do, Branch, Format, CompatibleDo, CompatibleBranch)
23 using LabeledStmtClassificationSet =
24     common::EnumSet<TargetStatementEnum, TargetStatementEnum_enumSize>;
25 
26 using IndexList = std::vector<std::pair<parser::CharBlock, parser::CharBlock>>;
27 // A ProxyForScope is an integral proxy for a Fortran scope. This is required
28 // because the parse tree does not actually have the scopes required.
29 using ProxyForScope = unsigned;
30 // Minimal scope information
31 struct ScopeInfo {
32   ProxyForScope parent{};
33   bool isExteriorGotoFatal{false};
34   int depth{0};
35 };
36 struct LabeledStatementInfoTuplePOD {
37   ProxyForScope proxyForScope;
38   parser::CharBlock parserCharBlock;
39   LabeledStmtClassificationSet labeledStmtClassificationSet;
40   bool isExecutableConstructEndStmt;
41 };
42 using TargetStmtMap = std::map<parser::Label, LabeledStatementInfoTuplePOD>;
43 struct SourceStatementInfoTuplePOD {
44   SourceStatementInfoTuplePOD(const parser::Label &parserLabel,
45       const ProxyForScope &proxyForScope,
46       const parser::CharBlock &parserCharBlock)
47       : parserLabel{parserLabel}, proxyForScope{proxyForScope},
48         parserCharBlock{parserCharBlock} {}
49   parser::Label parserLabel;
50   ProxyForScope proxyForScope;
51   parser::CharBlock parserCharBlock;
52 };
53 using SourceStmtList = std::vector<SourceStatementInfoTuplePOD>;
54 enum class Legality { never, always, formerly };
55 
56 bool HasScope(ProxyForScope scope) { return scope != ProxyForScope{0u}; }
57 
58 // F18:R1131
59 template <typename A>
60 constexpr Legality IsLegalDoTerm(const parser::Statement<A> &) {
61   if (std::is_same_v<A, common::Indirection<parser::EndDoStmt>> ||
62       std::is_same_v<A, parser::EndDoStmt>) {
63     return Legality::always;
64   } else if (std::is_same_v<A, parser::EndForallStmt> ||
65       std::is_same_v<A, parser::EndWhereStmt>) {
66     // Executable construct end statements are also supported as
67     // an extension but they need special care because the associated
68     // construct create their own scope.
69     return Legality::formerly;
70   } else {
71     return Legality::never;
72   }
73 }
74 
75 constexpr Legality IsLegalDoTerm(
76     const parser::Statement<parser::ActionStmt> &actionStmt) {
77   if (std::holds_alternative<parser::ContinueStmt>(actionStmt.statement.u)) {
78     // See F08:C816
79     return Legality::always;
80   } else if (!(std::holds_alternative<
81                    common::Indirection<parser::ArithmeticIfStmt>>(
82                    actionStmt.statement.u) ||
83                  std::holds_alternative<common::Indirection<parser::CycleStmt>>(
84                      actionStmt.statement.u) ||
85                  std::holds_alternative<common::Indirection<parser::ExitStmt>>(
86                      actionStmt.statement.u) ||
87                  std::holds_alternative<common::Indirection<parser::StopStmt>>(
88                      actionStmt.statement.u) ||
89                  std::holds_alternative<common::Indirection<parser::GotoStmt>>(
90                      actionStmt.statement.u) ||
91                  std::holds_alternative<
92                      common::Indirection<parser::ReturnStmt>>(
93                      actionStmt.statement.u))) {
94     return Legality::formerly;
95   } else {
96     return Legality::never;
97   }
98 }
99 
100 template <typename A> constexpr bool IsFormat(const parser::Statement<A> &) {
101   return std::is_same_v<A, common::Indirection<parser::FormatStmt>>;
102 }
103 
104 template <typename A>
105 constexpr Legality IsLegalBranchTarget(const parser::Statement<A> &) {
106   if (std::is_same_v<A, parser::ActionStmt> ||
107       std::is_same_v<A, parser::AssociateStmt> ||
108       std::is_same_v<A, parser::EndAssociateStmt> ||
109       std::is_same_v<A, parser::IfThenStmt> ||
110       std::is_same_v<A, parser::EndIfStmt> ||
111       std::is_same_v<A, parser::SelectCaseStmt> ||
112       std::is_same_v<A, parser::EndSelectStmt> ||
113       std::is_same_v<A, parser::SelectRankStmt> ||
114       std::is_same_v<A, parser::SelectTypeStmt> ||
115       std::is_same_v<A, common::Indirection<parser::LabelDoStmt>> ||
116       std::is_same_v<A, parser::NonLabelDoStmt> ||
117       std::is_same_v<A, parser::EndDoStmt> ||
118       std::is_same_v<A, common::Indirection<parser::EndDoStmt>> ||
119       std::is_same_v<A, parser::BlockStmt> ||
120       std::is_same_v<A, parser::EndBlockStmt> ||
121       std::is_same_v<A, parser::CriticalStmt> ||
122       std::is_same_v<A, parser::EndCriticalStmt> ||
123       std::is_same_v<A, parser::ForallConstructStmt> ||
124       std::is_same_v<A, parser::WhereConstructStmt> ||
125       std::is_same_v<A, parser::EndFunctionStmt> ||
126       std::is_same_v<A, parser::EndMpSubprogramStmt> ||
127       std::is_same_v<A, parser::EndProgramStmt> ||
128       std::is_same_v<A, parser::EndSubroutineStmt>) {
129     return Legality::always;
130   } else {
131     return Legality::never;
132   }
133 }
134 
135 template <typename A>
136 constexpr LabeledStmtClassificationSet ConstructBranchTargetFlags(
137     const parser::Statement<A> &statement) {
138   LabeledStmtClassificationSet labeledStmtClassificationSet{};
139   if (IsLegalDoTerm(statement) == Legality::always) {
140     labeledStmtClassificationSet.set(TargetStatementEnum::Do);
141   } else if (IsLegalDoTerm(statement) == Legality::formerly) {
142     labeledStmtClassificationSet.set(TargetStatementEnum::CompatibleDo);
143   }
144   if (IsLegalBranchTarget(statement) == Legality::always) {
145     labeledStmtClassificationSet.set(TargetStatementEnum::Branch);
146   } else if (IsLegalBranchTarget(statement) == Legality::formerly) {
147     labeledStmtClassificationSet.set(TargetStatementEnum::CompatibleBranch);
148   }
149   if (IsFormat(statement)) {
150     labeledStmtClassificationSet.set(TargetStatementEnum::Format);
151   }
152   return labeledStmtClassificationSet;
153 }
154 
155 static unsigned SayLabel(parser::Label label) {
156   return static_cast<unsigned>(label);
157 }
158 
159 struct UnitAnalysis {
160   UnitAnalysis() { scopeModel.emplace_back(); }
161 
162   SourceStmtList doStmtSources;
163   SourceStmtList formatStmtSources;
164   SourceStmtList otherStmtSources;
165   SourceStmtList assignStmtSources;
166   TargetStmtMap targetStmts;
167   std::vector<ScopeInfo> scopeModel;
168 };
169 
170 // Some parse tree record for statements simply wrap construct names;
171 // others include them as tuple components.  Given a statement,
172 // return a pointer to its name if it has one.
173 template <typename A>
174 const parser::CharBlock *GetStmtName(const parser::Statement<A> &stmt) {
175   const std::optional<parser::Name> *name{nullptr};
176   if constexpr (WrapperTrait<A>) {
177     if constexpr (std::is_same_v<decltype(A::v), parser::Name>) {
178       return &stmt.statement.v.source;
179     } else {
180       name = &stmt.statement.v;
181     }
182   } else if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
183       std::is_same_v<A, parser::SelectTypeStmt>) {
184     name = &std::get<0>(stmt.statement.t);
185   } else if constexpr (common::HasMember<parser::Name,
186                            decltype(stmt.statement.t)>) {
187     return &std::get<parser::Name>(stmt.statement.t).source;
188   } else {
189     name = &std::get<std::optional<parser::Name>>(stmt.statement.t);
190   }
191   if (name && *name) {
192     return &(*name)->source;
193   }
194   return nullptr;
195 }
196 
197 class ParseTreeAnalyzer {
198 public:
199   ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default;
200   ParseTreeAnalyzer(SemanticsContext &context) : context_{context} {}
201 
202   template <typename A> constexpr bool Pre(const A &x) {
203     using LabeledProgramUnitStmts =
204         std::tuple<parser::MainProgram, parser::FunctionSubprogram,
205             parser::SubroutineSubprogram, parser::SeparateModuleSubprogram>;
206     if constexpr (common::HasMember<A, LabeledProgramUnitStmts>) {
207       const auto &endStmt{std::get<std::tuple_size_v<decltype(x.t)> - 1>(x.t)};
208       if (endStmt.label) {
209         // The END statement for a subprogram appears after any internal
210         // subprograms.  Visit that statement in advance so that results
211         // are placed in the correct programUnits_ slot.
212         auto targetFlags{ConstructBranchTargetFlags(endStmt)};
213         AddTargetLabelDefinition(
214             endStmt.label.value(), targetFlags, currentScope_);
215       }
216     }
217     return true;
218   }
219   template <typename A> constexpr void Post(const A &) {}
220 
221   template <typename A> bool Pre(const parser::Statement<A> &statement) {
222     currentPosition_ = statement.source;
223     const auto &label = statement.label;
224     if (!label) {
225       return true;
226     }
227     using LabeledConstructStmts = std::tuple<parser::AssociateStmt,
228         parser::BlockStmt, parser::ChangeTeamStmt, parser::CriticalStmt,
229         parser::IfThenStmt, parser::NonLabelDoStmt, parser::SelectCaseStmt,
230         parser::SelectRankStmt, parser::SelectTypeStmt,
231         parser::ForallConstructStmt, parser::WhereConstructStmt>;
232     using LabeledConstructEndStmts = std::tuple<parser::EndAssociateStmt,
233         parser::EndBlockStmt, parser::EndChangeTeamStmt,
234         parser::EndCriticalStmt, parser::EndDoStmt, parser::EndForallStmt,
235         parser::EndIfStmt, parser::EndWhereStmt>;
236     using LabeledProgramUnitEndStmts =
237         std::tuple<parser::EndFunctionStmt, parser::EndMpSubprogramStmt,
238             parser::EndProgramStmt, parser::EndSubroutineStmt>;
239     auto targetFlags{ConstructBranchTargetFlags(statement)};
240     if constexpr (common::HasMember<A, LabeledConstructStmts>) {
241       AddTargetLabelDefinition(label.value(), targetFlags, ParentScope());
242     } else if constexpr (std::is_same_v<A, parser::EndIfStmt> ||
243         std::is_same_v<A, parser::EndSelectStmt>) {
244       // the label on an END IF/SELECT is not in the last part/case
245       AddTargetLabelDefinition(label.value(), targetFlags, ParentScope(), true);
246     } else if constexpr (common::HasMember<A, LabeledConstructEndStmts>) {
247       constexpr bool isExecutableConstructEndStmt{true};
248       AddTargetLabelDefinition(label.value(), targetFlags, currentScope_,
249           isExecutableConstructEndStmt);
250     } else if constexpr (!common::HasMember<A, LabeledProgramUnitEndStmts>) {
251       // Program unit END statements have already been processed.
252       AddTargetLabelDefinition(label.value(), targetFlags, currentScope_);
253     }
254     return true;
255   }
256 
257   // see 11.1.1
258   bool Pre(const parser::ProgramUnit &) { return InitializeNewScopeContext(); }
259   bool Pre(const parser::InternalSubprogram &) {
260     return InitializeNewScopeContext();
261   }
262   bool Pre(const parser::ModuleSubprogram &) {
263     return InitializeNewScopeContext();
264   }
265   bool Pre(const parser::AssociateConstruct &associateConstruct) {
266     return PushConstructName(associateConstruct);
267   }
268   bool Pre(const parser::BlockConstruct &blockConstruct) {
269     return PushConstructName(blockConstruct);
270   }
271   bool Pre(const parser::ChangeTeamConstruct &changeTeamConstruct) {
272     return PushConstructName(changeTeamConstruct);
273   }
274   bool Pre(const parser::CriticalConstruct &criticalConstruct) {
275     return PushConstructName(criticalConstruct);
276   }
277   bool Pre(const parser::DoConstruct &doConstruct) {
278     const auto &optionalName{std::get<std::optional<parser::Name>>(
279         std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)
280             .statement.t)};
281     if (optionalName) {
282       constructNames_.emplace_back(optionalName->ToString());
283     }
284     // Allow FORTRAN '66 extended DO ranges
285     PushScope(false);
286     // Process labels of the DO and END DO statements, but not the
287     // statements themselves, so that a non-construct END DO
288     // can be distinguished (below).
289     Pre(std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t));
290     Walk(std::get<parser::Block>(doConstruct.t), *this);
291     Pre(std::get<parser::Statement<parser::EndDoStmt>>(doConstruct.t));
292     PopConstructName(doConstruct);
293     return false;
294   }
295   void Post(const parser::EndDoStmt &endDoStmt) {
296     // Visited only for non-construct labeled DO termination
297     if (const auto &name{endDoStmt.v}) {
298       context_.Say(name->source, "Unexpected DO construct name '%s'"_err_en_US,
299           name->source);
300     }
301   }
302   bool Pre(const parser::IfConstruct &ifConstruct) {
303     return PushConstructName(ifConstruct);
304   }
305   void Post(const parser::IfThenStmt &) { PushScope(false); }
306   bool Pre(const parser::IfConstruct::ElseIfBlock &) {
307     return SwitchToNewScope();
308   }
309   bool Pre(const parser::IfConstruct::ElseBlock &) {
310     return SwitchToNewScope();
311   }
312   bool Pre(const parser::EndIfStmt &) {
313     PopScope();
314     return true;
315   }
316   bool Pre(const parser::CaseConstruct &caseConstruct) {
317     return PushConstructName(caseConstruct);
318   }
319   void Post(const parser::SelectCaseStmt &) { PushScope(false); }
320   bool Pre(const parser::CaseConstruct::Case &) { return SwitchToNewScope(); }
321   bool Pre(const parser::SelectRankConstruct &selectRankConstruct) {
322     return PushConstructName(selectRankConstruct);
323   }
324   void Post(const parser::SelectRankStmt &) { PushScope(true); }
325   bool Pre(const parser::SelectRankConstruct::RankCase &) {
326     return SwitchToNewScope();
327   }
328   bool Pre(const parser::SelectTypeConstruct &selectTypeConstruct) {
329     return PushConstructName(selectTypeConstruct);
330   }
331   void Post(const parser::SelectTypeStmt &) { PushScope(true); }
332   bool Pre(const parser::SelectTypeConstruct::TypeCase &) {
333     return SwitchToNewScope();
334   }
335   void Post(const parser::EndSelectStmt &) { PopScope(); }
336   bool Pre(const parser::WhereConstruct &whereConstruct) {
337     return PushConstructName(whereConstruct);
338   }
339   bool Pre(const parser::ForallConstruct &forallConstruct) {
340     return PushConstructName(forallConstruct);
341   }
342 
343   void Post(const parser::AssociateConstruct &associateConstruct) {
344     PopConstructName(associateConstruct);
345   }
346   void Post(const parser::BlockConstruct &blockConstruct) {
347     PopConstructName(blockConstruct);
348   }
349   void Post(const parser::ChangeTeamConstruct &changeTeamConstruct) {
350     PopConstructName(changeTeamConstruct);
351   }
352   void Post(const parser::CriticalConstruct &criticalConstruct) {
353     PopConstructName(criticalConstruct);
354   }
355   void Post(const parser::IfConstruct &ifConstruct) {
356     PopConstructName(ifConstruct);
357   }
358   void Post(const parser::CaseConstruct &caseConstruct) {
359     PopConstructName(caseConstruct);
360   }
361   void Post(const parser::SelectRankConstruct &selectRankConstruct) {
362     PopConstructName(selectRankConstruct);
363   }
364   void Post(const parser::SelectTypeConstruct &selectTypeConstruct) {
365     PopConstructName(selectTypeConstruct);
366   }
367   void Post(const parser::WhereConstruct &whereConstruct) {
368     PopConstructName(whereConstruct);
369   }
370   void Post(const parser::ForallConstruct &forallConstruct) {
371     PopConstructName(forallConstruct);
372   }
373 
374   // Checks for missing or mismatching names on various constructs (e.g., IF)
375   // and their intermediate or terminal statements that allow optional
376   // construct names(e.g., ELSE).  When an optional construct name is present,
377   // the construct as a whole must have a name that matches.
378   template <typename FIRST, typename CONSTRUCT, typename STMT>
379   void CheckOptionalName(const char *constructTag, const CONSTRUCT &a,
380       const parser::Statement<STMT> &stmt) {
381     if (const parser::CharBlock * name{GetStmtName(stmt)}) {
382       const auto &firstStmt{std::get<parser::Statement<FIRST>>(a.t)};
383       if (const parser::CharBlock * firstName{GetStmtName(firstStmt)}) {
384         if (*firstName != *name) {
385           context_.Say(*name, "%s name mismatch"_err_en_US, constructTag)
386               .Attach(*firstName, "should be"_en_US);
387         }
388       } else {
389         context_.Say(*name, "%s name not allowed"_err_en_US, constructTag)
390             .Attach(firstStmt.source, "in unnamed %s"_en_US, constructTag);
391       }
392     }
393   }
394 
395   // C1414
396   void Post(const parser::BlockData &blockData) {
397     CheckOptionalName<parser::BlockDataStmt>("BLOCK DATA subprogram", blockData,
398         std::get<parser::Statement<parser::EndBlockDataStmt>>(blockData.t));
399   }
400 
401   bool Pre(const parser::InterfaceBody &) {
402     PushDisposableMap();
403     return true;
404   }
405   void Post(const parser::InterfaceBody &) { PopDisposableMap(); }
406 
407   // C1564
408   void Post(const parser::InterfaceBody::Function &func) {
409     CheckOptionalName<parser::FunctionStmt>("FUNCTION", func,
410         std::get<parser::Statement<parser::EndFunctionStmt>>(func.t));
411   }
412 
413   // C1564
414   void Post(const parser::FunctionSubprogram &functionSubprogram) {
415     CheckOptionalName<parser::FunctionStmt>("FUNCTION", functionSubprogram,
416         std::get<parser::Statement<parser::EndFunctionStmt>>(
417             functionSubprogram.t));
418   }
419 
420   // C1502
421   void Post(const parser::InterfaceBlock &interfaceBlock) {
422     if (const auto &endGenericSpec{
423             std::get<parser::Statement<parser::EndInterfaceStmt>>(
424                 interfaceBlock.t)
425                 .statement.v}) {
426       const auto &interfaceStmt{
427           std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t)};
428       if (std::holds_alternative<parser::Abstract>(interfaceStmt.statement.u)) {
429         context_
430             .Say(endGenericSpec->source,
431                 "END INTERFACE generic name (%s) may not appear for ABSTRACT INTERFACE"_err_en_US,
432                 endGenericSpec->source)
433             .Attach(
434                 interfaceStmt.source, "corresponding ABSTRACT INTERFACE"_en_US);
435       } else if (const auto &genericSpec{
436                      std::get<std::optional<parser::GenericSpec>>(
437                          interfaceStmt.statement.u)}) {
438         bool ok{genericSpec->source == endGenericSpec->source};
439         if (!ok) {
440           // Accept variant spellings of .LT. &c.
441           const auto *endOp{
442               std::get_if<parser::DefinedOperator>(&endGenericSpec->u)};
443           const auto *op{std::get_if<parser::DefinedOperator>(&genericSpec->u)};
444           if (endOp && op) {
445             const auto *endIntrin{
446                 std::get_if<parser::DefinedOperator::IntrinsicOperator>(
447                     &endOp->u)};
448             const auto *intrin{
449                 std::get_if<parser::DefinedOperator::IntrinsicOperator>(
450                     &op->u)};
451             ok = endIntrin && intrin && *endIntrin == *intrin;
452           }
453         }
454         if (!ok) {
455           context_
456               .Say(endGenericSpec->source,
457                   "END INTERFACE generic name (%s) does not match generic INTERFACE (%s)"_err_en_US,
458                   endGenericSpec->source, genericSpec->source)
459               .Attach(genericSpec->source, "corresponding INTERFACE"_en_US);
460         }
461       } else {
462         context_
463             .Say(endGenericSpec->source,
464                 "END INTERFACE generic name (%s) may not appear for non-generic INTERFACE"_err_en_US,
465                 endGenericSpec->source)
466             .Attach(interfaceStmt.source, "corresponding INTERFACE"_en_US);
467       }
468     }
469   }
470 
471   // C1402
472   void Post(const parser::Module &module) {
473     CheckOptionalName<parser::ModuleStmt>("MODULE", module,
474         std::get<parser::Statement<parser::EndModuleStmt>>(module.t));
475   }
476 
477   // C1569
478   void Post(const parser::SeparateModuleSubprogram &separateModuleSubprogram) {
479     CheckOptionalName<parser::MpSubprogramStmt>("MODULE PROCEDURE",
480         separateModuleSubprogram,
481         std::get<parser::Statement<parser::EndMpSubprogramStmt>>(
482             separateModuleSubprogram.t));
483   }
484 
485   // C1401
486   void Post(const parser::MainProgram &mainProgram) {
487     if (const parser::CharBlock *
488         endName{GetStmtName(std::get<parser::Statement<parser::EndProgramStmt>>(
489             mainProgram.t))}) {
490       if (const auto &program{
491               std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(
492                   mainProgram.t)}) {
493         if (*endName != program->statement.v.source) {
494           context_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
495               .Attach(program->statement.v.source, "should be"_en_US);
496         }
497       } else {
498         context_.Say(*endName,
499             "END PROGRAM has name without PROGRAM statement"_err_en_US);
500       }
501     }
502   }
503 
504   // C1413
505   void Post(const parser::Submodule &submodule) {
506     CheckOptionalName<parser::SubmoduleStmt>("SUBMODULE", submodule,
507         std::get<parser::Statement<parser::EndSubmoduleStmt>>(submodule.t));
508   }
509 
510   // C1567
511   void Post(const parser::InterfaceBody::Subroutine &sub) {
512     CheckOptionalName<parser::SubroutineStmt>("SUBROUTINE", sub,
513         std::get<parser::Statement<parser::EndSubroutineStmt>>(sub.t));
514   }
515 
516   // C1567
517   void Post(const parser::SubroutineSubprogram &subroutineSubprogram) {
518     CheckOptionalName<parser::SubroutineStmt>("SUBROUTINE",
519         subroutineSubprogram,
520         std::get<parser::Statement<parser::EndSubroutineStmt>>(
521             subroutineSubprogram.t));
522   }
523 
524   // C739
525   bool Pre(const parser::DerivedTypeDef &) {
526     PushDisposableMap();
527     return true;
528   }
529   void Post(const parser::DerivedTypeDef &derivedTypeDef) {
530     CheckOptionalName<parser::DerivedTypeStmt>("derived type definition",
531         derivedTypeDef,
532         std::get<parser::Statement<parser::EndTypeStmt>>(derivedTypeDef.t));
533     PopDisposableMap();
534   }
535 
536   void Post(const parser::LabelDoStmt &labelDoStmt) {
537     AddLabelReferenceFromDoStmt(std::get<parser::Label>(labelDoStmt.t));
538   }
539   void Post(const parser::GotoStmt &gotoStmt) { AddLabelReference(gotoStmt.v); }
540   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
541     AddLabelReference(std::get<std::list<parser::Label>>(computedGotoStmt.t));
542   }
543   void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
544     AddLabelReference(std::get<1>(arithmeticIfStmt.t));
545     AddLabelReference(std::get<2>(arithmeticIfStmt.t));
546     AddLabelReference(std::get<3>(arithmeticIfStmt.t));
547   }
548   void Post(const parser::AssignStmt &assignStmt) {
549     AddLabelReferenceFromAssignStmt(std::get<parser::Label>(assignStmt.t));
550   }
551   void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
552     AddLabelReference(std::get<std::list<parser::Label>>(assignedGotoStmt.t));
553   }
554   void Post(const parser::AltReturnSpec &altReturnSpec) {
555     AddLabelReference(altReturnSpec.v);
556   }
557 
558   void Post(const parser::ErrLabel &errLabel) { AddLabelReference(errLabel.v); }
559   void Post(const parser::EndLabel &endLabel) { AddLabelReference(endLabel.v); }
560   void Post(const parser::EorLabel &eorLabel) { AddLabelReference(eorLabel.v); }
561   void Post(const parser::Format &format) {
562     if (const auto *labelPointer{std::get_if<parser::Label>(&format.u)}) {
563       AddLabelReferenceToFormatStmt(*labelPointer);
564     }
565   }
566   void Post(const parser::CycleStmt &cycleStmt) {
567     if (cycleStmt.v) {
568       CheckLabelContext("CYCLE", cycleStmt.v->source);
569     }
570   }
571   void Post(const parser::ExitStmt &exitStmt) {
572     if (exitStmt.v) {
573       CheckLabelContext("EXIT", exitStmt.v->source);
574     }
575   }
576 
577   const std::vector<UnitAnalysis> &ProgramUnits() const {
578     return programUnits_;
579   }
580   SemanticsContext &ErrorHandler() { return context_; }
581 
582 private:
583   ScopeInfo &PushScope(bool isExteriorGotoFatal) {
584     auto &model{programUnits_.back().scopeModel};
585     int newDepth{model.empty() ? 1 : model[currentScope_].depth + 1};
586     ScopeInfo &result{model.emplace_back()};
587     result.parent = currentScope_;
588     result.depth = newDepth;
589     result.isExteriorGotoFatal = isExteriorGotoFatal;
590     currentScope_ = model.size() - 1;
591     return result;
592   }
593   bool InitializeNewScopeContext() {
594     programUnits_.emplace_back(UnitAnalysis{});
595     currentScope_ = 0u;
596     PushScope(false);
597     return true;
598   }
599   ScopeInfo &PopScope() {
600     ScopeInfo &result{programUnits_.back().scopeModel[currentScope_]};
601     currentScope_ = result.parent;
602     return result;
603   }
604   ProxyForScope ParentScope() {
605     return programUnits_.back().scopeModel[currentScope_].parent;
606   }
607   bool SwitchToNewScope() {
608     PushScope(PopScope().isExteriorGotoFatal);
609     return true;
610   }
611 
612   template <typename A> bool PushConstructName(const A &a) {
613     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
614     if (optionalName) {
615       constructNames_.emplace_back(optionalName->ToString());
616     }
617     // Gotos into this construct from outside it are diagnosed, and
618     // are fatal unless the construct is a DO, IF, or SELECT CASE.
619     PushScope(!(std::is_same_v<A, parser::DoConstruct> ||
620         std::is_same_v<A, parser::IfConstruct> ||
621         std::is_same_v<A, parser::CaseConstruct>));
622     return true;
623   }
624   bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
625     const auto &optionalName{
626         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
627             .statement.v};
628     if (optionalName) {
629       constructNames_.emplace_back(optionalName->ToString());
630     }
631     PushScope(true);
632     return true;
633   }
634   template <typename A> void PopConstructNameIfPresent(const A &a) {
635     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
636     if (optionalName) {
637       constructNames_.pop_back();
638     }
639   }
640   void PopConstructNameIfPresent(const parser::BlockConstruct &blockConstruct) {
641     const auto &optionalName{
642         std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
643             .statement.v};
644     if (optionalName) {
645       constructNames_.pop_back();
646     }
647   }
648 
649   template <typename A> void PopConstructName(const A &a) {
650     CheckName(a);
651     PopScope();
652     PopConstructNameIfPresent(a);
653   }
654 
655   template <typename FIRST, typename CASEBLOCK, typename CASE,
656       typename CONSTRUCT>
657   void CheckSelectNames(const char *tag, const CONSTRUCT &construct) {
658     CheckEndName<FIRST, parser::EndSelectStmt>(tag, construct);
659     for (const auto &inner : std::get<std::list<CASEBLOCK>>(construct.t)) {
660       CheckOptionalName<FIRST>(
661           tag, construct, std::get<parser::Statement<CASE>>(inner.t));
662     }
663   }
664 
665   // C1144
666   void PopConstructName(const parser::CaseConstruct &caseConstruct) {
667     CheckSelectNames<parser::SelectCaseStmt, parser::CaseConstruct::Case,
668         parser::CaseStmt>("SELECT CASE", caseConstruct);
669     PopScope();
670     PopConstructNameIfPresent(caseConstruct);
671   }
672 
673   // C1154, C1156
674   void PopConstructName(
675       const parser::SelectRankConstruct &selectRankConstruct) {
676     CheckSelectNames<parser::SelectRankStmt,
677         parser::SelectRankConstruct::RankCase, parser::SelectRankCaseStmt>(
678         "SELECT RANK", selectRankConstruct);
679     PopScope();
680     PopConstructNameIfPresent(selectRankConstruct);
681   }
682 
683   // C1165
684   void PopConstructName(
685       const parser::SelectTypeConstruct &selectTypeConstruct) {
686     CheckSelectNames<parser::SelectTypeStmt,
687         parser::SelectTypeConstruct::TypeCase, parser::TypeGuardStmt>(
688         "SELECT TYPE", selectTypeConstruct);
689     PopScope();
690     PopConstructNameIfPresent(selectTypeConstruct);
691   }
692 
693   // Checks for missing or mismatching names on various constructs (e.g., BLOCK)
694   // and their END statements.  Both names must be present if either one is.
695   template <typename FIRST, typename END, typename CONSTRUCT>
696   void CheckEndName(const char *constructTag, const CONSTRUCT &a) {
697     const auto &constructStmt{std::get<parser::Statement<FIRST>>(a.t)};
698     const auto &endStmt{std::get<parser::Statement<END>>(a.t)};
699     const parser::CharBlock *endName{GetStmtName(endStmt)};
700     if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
701       if (endName) {
702         if (*constructName != *endName) {
703           context_
704               .Say(*endName, "%s construct name mismatch"_err_en_US,
705                   constructTag)
706               .Attach(*constructName, "should be"_en_US);
707         }
708       } else {
709         context_
710             .Say(endStmt.source,
711                 "%s construct name required but missing"_err_en_US,
712                 constructTag)
713             .Attach(*constructName, "should be"_en_US);
714       }
715     } else if (endName) {
716       context_
717           .Say(*endName, "%s construct name unexpected"_err_en_US, constructTag)
718           .Attach(
719               constructStmt.source, "unnamed %s statement"_en_US, constructTag);
720     }
721   }
722 
723   // C1106
724   void CheckName(const parser::AssociateConstruct &associateConstruct) {
725     CheckEndName<parser::AssociateStmt, parser::EndAssociateStmt>(
726         "ASSOCIATE", associateConstruct);
727   }
728   // C1117
729   void CheckName(const parser::CriticalConstruct &criticalConstruct) {
730     CheckEndName<parser::CriticalStmt, parser::EndCriticalStmt>(
731         "CRITICAL", criticalConstruct);
732   }
733   // C1131
734   void CheckName(const parser::DoConstruct &doConstruct) {
735     CheckEndName<parser::NonLabelDoStmt, parser::EndDoStmt>("DO", doConstruct);
736     if (auto label{std::get<std::optional<parser::Label>>(
737             std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)
738                 .statement.t)}) {
739       const auto &endDoStmt{
740           std::get<parser::Statement<parser::EndDoStmt>>(doConstruct.t)};
741       if (!endDoStmt.label || *endDoStmt.label != *label) {
742         context_
743             .Say(endDoStmt.source,
744                 "END DO statement must have the label '%d' matching its DO statement"_err_en_US,
745                 *label)
746             .Attach(std::get<parser::Statement<parser::NonLabelDoStmt>>(
747                         doConstruct.t)
748                         .source,
749                 "corresponding DO statement"_en_US);
750       }
751     }
752   }
753   // C1035
754   void CheckName(const parser::ForallConstruct &forallConstruct) {
755     CheckEndName<parser::ForallConstructStmt, parser::EndForallStmt>(
756         "FORALL", forallConstruct);
757   }
758 
759   // C1109
760   void CheckName(const parser::BlockConstruct &blockConstruct) {
761     CheckEndName<parser::BlockStmt, parser::EndBlockStmt>(
762         "BLOCK", blockConstruct);
763   }
764   // C1112
765   void CheckName(const parser::ChangeTeamConstruct &changeTeamConstruct) {
766     CheckEndName<parser::ChangeTeamStmt, parser::EndChangeTeamStmt>(
767         "CHANGE TEAM", changeTeamConstruct);
768   }
769 
770   // C1142
771   void CheckName(const parser::IfConstruct &ifConstruct) {
772     CheckEndName<parser::IfThenStmt, parser::EndIfStmt>("IF", ifConstruct);
773     for (const auto &elseIfBlock :
774         std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
775       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
776           std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t));
777     }
778     if (const auto &elseBlock{
779             std::get<std::optional<parser::IfConstruct::ElseBlock>>(
780                 ifConstruct.t)}) {
781       CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
782           std::get<parser::Statement<parser::ElseStmt>>(elseBlock->t));
783     }
784   }
785 
786   // C1033
787   void CheckName(const parser::WhereConstruct &whereConstruct) {
788     CheckEndName<parser::WhereConstructStmt, parser::EndWhereStmt>(
789         "WHERE", whereConstruct);
790     for (const auto &maskedElsewhere :
791         std::get<std::list<parser::WhereConstruct::MaskedElsewhere>>(
792             whereConstruct.t)) {
793       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
794           whereConstruct,
795           std::get<parser::Statement<parser::MaskedElsewhereStmt>>(
796               maskedElsewhere.t));
797     }
798     if (const auto &elsewhere{
799             std::get<std::optional<parser::WhereConstruct::Elsewhere>>(
800                 whereConstruct.t)}) {
801       CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
802           whereConstruct,
803           std::get<parser::Statement<parser::ElsewhereStmt>>(elsewhere->t));
804     }
805   }
806 
807   // C1134, C1166
808   void CheckLabelContext(
809       const char *const stmtString, const parser::CharBlock &constructName) {
810     const auto iter{std::find(constructNames_.crbegin(),
811         constructNames_.crend(), constructName.ToString())};
812     if (iter == constructNames_.crend()) {
813       context_.Say(constructName, "%s construct-name is not in scope"_err_en_US,
814           stmtString);
815     }
816   }
817 
818   // 6.2.5, paragraph 2
819   void CheckLabelInRange(parser::Label label) {
820     if (label < 1 || label > 99999) {
821       context_.Say(currentPosition_, "Label '%u' is out of range"_err_en_US,
822           SayLabel(label));
823     }
824   }
825 
826   // 6.2.5., paragraph 2
827   void AddTargetLabelDefinition(parser::Label label,
828       LabeledStmtClassificationSet labeledStmtClassificationSet,
829       ProxyForScope scope, bool isExecutableConstructEndStmt = false) {
830     CheckLabelInRange(label);
831     TargetStmtMap &targetStmtMap{disposableMaps_.empty()
832             ? programUnits_.back().targetStmts
833             : disposableMaps_.back()};
834     const auto pair{targetStmtMap.emplace(label,
835         LabeledStatementInfoTuplePOD{scope, currentPosition_,
836             labeledStmtClassificationSet, isExecutableConstructEndStmt})};
837     if (!pair.second) {
838       context_.Say(currentPosition_, "Label '%u' is not distinct"_err_en_US,
839           SayLabel(label));
840     }
841   }
842 
843   void AddLabelReferenceFromDoStmt(parser::Label label) {
844     CheckLabelInRange(label);
845     programUnits_.back().doStmtSources.emplace_back(
846         label, currentScope_, currentPosition_);
847   }
848 
849   void AddLabelReferenceToFormatStmt(parser::Label label) {
850     CheckLabelInRange(label);
851     programUnits_.back().formatStmtSources.emplace_back(
852         label, currentScope_, currentPosition_);
853   }
854 
855   void AddLabelReferenceFromAssignStmt(parser::Label label) {
856     CheckLabelInRange(label);
857     programUnits_.back().assignStmtSources.emplace_back(
858         label, currentScope_, currentPosition_);
859   }
860 
861   void AddLabelReference(parser::Label label) {
862     CheckLabelInRange(label);
863     programUnits_.back().otherStmtSources.emplace_back(
864         label, currentScope_, currentPosition_);
865   }
866 
867   void AddLabelReference(const std::list<parser::Label> &labels) {
868     for (const parser::Label &label : labels) {
869       AddLabelReference(label);
870     }
871   }
872 
873   void PushDisposableMap() { disposableMaps_.emplace_back(); }
874   void PopDisposableMap() { disposableMaps_.pop_back(); }
875 
876   std::vector<UnitAnalysis> programUnits_;
877   SemanticsContext &context_;
878   parser::CharBlock currentPosition_;
879   ProxyForScope currentScope_;
880   std::vector<std::string> constructNames_;
881   // For labels in derived type definitions and procedure
882   // interfaces, which are their own inclusive scopes.  None
883   // of these labels can be used as a branch target, but they
884   // should be pairwise distinct.
885   std::vector<TargetStmtMap> disposableMaps_;
886 };
887 
888 bool InInclusiveScope(const std::vector<ScopeInfo> &scopes, ProxyForScope tail,
889     ProxyForScope head) {
890   for (; tail != head; tail = scopes[tail].parent) {
891     if (!HasScope(tail)) {
892       return false;
893     }
894   }
895   return true;
896 }
897 
898 ParseTreeAnalyzer LabelAnalysis(
899     SemanticsContext &context, const parser::Program &program) {
900   ParseTreeAnalyzer analysis{context};
901   Walk(program, analysis);
902   return analysis;
903 }
904 
905 bool InBody(const parser::CharBlock &position,
906     const std::pair<parser::CharBlock, parser::CharBlock> &pair) {
907   if (position.begin() >= pair.first.begin()) {
908     if (position.begin() < pair.second.end()) {
909       return true;
910     }
911   }
912   return false;
913 }
914 
915 LabeledStatementInfoTuplePOD GetLabel(
916     const TargetStmtMap &labels, const parser::Label &label) {
917   const auto iter{labels.find(label)};
918   if (iter == labels.cend()) {
919     return {0u, nullptr, LabeledStmtClassificationSet{}, false};
920   } else {
921     return iter->second;
922   }
923 }
924 
925 // 11.1.7.3
926 void CheckBranchesIntoDoBody(const SourceStmtList &branches,
927     const TargetStmtMap &labels, const IndexList &loopBodies,
928     SemanticsContext &context) {
929   for (const auto &branch : branches) {
930     const auto &label{branch.parserLabel};
931     auto branchTarget{GetLabel(labels, label)};
932     if (HasScope(branchTarget.proxyForScope)) {
933       const auto &fromPosition{branch.parserCharBlock};
934       const auto &toPosition{branchTarget.parserCharBlock};
935       for (const auto &body : loopBodies) {
936         if (!InBody(fromPosition, body) && InBody(toPosition, body) &&
937             context.ShouldWarn(common::LanguageFeature::BranchIntoConstruct)) {
938           context
939               .Say(
940                   fromPosition, "branch into loop body from outside"_warn_en_US)
941               .Attach(body.first, "the loop branched into"_en_US)
942               .set_languageFeature(
943                   common::LanguageFeature::BranchIntoConstruct);
944         }
945       }
946     }
947   }
948 }
949 
950 void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
951   for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
952     const auto &v1{*i1};
953     for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
954       const auto &v2{*i2};
955       if (v2.first.begin() < v1.second.end() &&
956           v1.second.begin() < v2.second.begin()) {
957         context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
958             .Attach(v2.first, "DO loop conflicts"_en_US);
959       }
960     }
961   }
962 }
963 
964 parser::CharBlock SkipLabel(const parser::CharBlock &position) {
965   const std::size_t maxPosition{position.size()};
966   if (maxPosition && parser::IsDecimalDigit(position[0])) {
967     std::size_t i{1l};
968     for (; (i < maxPosition) && parser::IsDecimalDigit(position[i]); ++i) {
969     }
970     for (; (i < maxPosition) && parser::IsWhiteSpace(position[i]); ++i) {
971     }
972     return parser::CharBlock{position.begin() + i, position.end()};
973   }
974   return position;
975 }
976 
977 ProxyForScope ParentScope(
978     const std::vector<ScopeInfo> &scopes, ProxyForScope scope) {
979   return scopes[scope].parent;
980 }
981 
982 void CheckLabelDoConstraints(const SourceStmtList &dos,
983     const SourceStmtList &branches, const TargetStmtMap &labels,
984     const std::vector<ScopeInfo> &scopes, SemanticsContext &context) {
985   IndexList loopBodies;
986   for (const auto &stmt : dos) {
987     const auto &label{stmt.parserLabel};
988     const auto &scope{stmt.proxyForScope};
989     const auto &position{stmt.parserCharBlock};
990     auto doTarget{GetLabel(labels, label)};
991     if (!HasScope(doTarget.proxyForScope)) {
992       // C1133
993       context.Say(
994           position, "Label '%u' cannot be found"_err_en_US, SayLabel(label));
995     } else if (doTarget.parserCharBlock.begin() < position.begin()) {
996       // R1119
997       context.Say(position,
998           "Label '%u' doesn't lexically follow DO stmt"_err_en_US,
999           SayLabel(label));
1000 
1001     } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
1002                    doTarget.labeledStmtClassificationSet.test(
1003                        TargetStatementEnum::CompatibleDo)) ||
1004         (doTarget.isExecutableConstructEndStmt &&
1005             ParentScope(scopes, doTarget.proxyForScope) == scope)) {
1006       if (context.ShouldWarn(
1007               common::LanguageFeature::OldLabelDoEndStatements)) {
1008         context
1009             .Say(position,
1010                 "A DO loop should terminate with an END DO or CONTINUE"_port_en_US)
1011             .Attach(doTarget.parserCharBlock,
1012                 "DO loop currently ends at statement:"_en_US)
1013             .set_languageFeature(
1014                 common::LanguageFeature::OldLabelDoEndStatements);
1015       }
1016     } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
1017       context.Say(position, "Label '%u' is not in DO loop scope"_err_en_US,
1018           SayLabel(label));
1019     } else if (!doTarget.labeledStmtClassificationSet.test(
1020                    TargetStatementEnum::Do)) {
1021       context.Say(doTarget.parserCharBlock,
1022           "A DO loop should terminate with an END DO or CONTINUE"_err_en_US);
1023     } else {
1024       loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
1025     }
1026   }
1027 
1028   CheckBranchesIntoDoBody(branches, labels, loopBodies, context);
1029   CheckDoNesting(loopBodies, context);
1030 }
1031 
1032 // 6.2.5
1033 void CheckScopeConstraints(const SourceStmtList &stmts,
1034     const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1035     SemanticsContext &context) {
1036   for (const auto &stmt : stmts) {
1037     const auto &label{stmt.parserLabel};
1038     const auto &scope{stmt.proxyForScope};
1039     const auto &position{stmt.parserCharBlock};
1040     auto target{GetLabel(labels, label)};
1041     if (!HasScope(target.proxyForScope)) {
1042       context.Say(
1043           position, "Label '%u' was not found"_err_en_US, SayLabel(label));
1044     } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
1045       // Clause 11.1.2.1 prohibits transfer of control to the interior of a
1046       // block from outside the block, but this does not apply to formats.
1047       // C1038 and C1034 forbid statements in FORALL and WHERE constructs
1048       // (resp.) from being branch targets.
1049       if (target.labeledStmtClassificationSet.test(
1050               TargetStatementEnum::Format)) {
1051         continue;
1052       }
1053       bool isFatal{false};
1054       ProxyForScope fromScope{scope};
1055       for (ProxyForScope toScope{target.proxyForScope}; HasScope(toScope);
1056            toScope = scopes[toScope].parent) {
1057         while (scopes[fromScope].depth > scopes[toScope].depth) {
1058           fromScope = scopes[fromScope].parent;
1059         }
1060         if (toScope == fromScope) {
1061           break;
1062         }
1063         if (scopes[toScope].isExteriorGotoFatal) {
1064           isFatal = true;
1065           break;
1066         }
1067       }
1068       if (isFatal) {
1069         context.Say(position,
1070             "Label '%u' is in a construct that prevents its use as a branch target here"_err_en_US,
1071             SayLabel(label));
1072       } else if (context.ShouldWarn(
1073                      common::LanguageFeature::BranchIntoConstruct)) {
1074         context
1075             .Say(position,
1076                 "Label '%u' is in a construct that should not be used as a branch target here"_warn_en_US,
1077                 SayLabel(label))
1078             .set_languageFeature(common::LanguageFeature::BranchIntoConstruct);
1079       }
1080     }
1081   }
1082 }
1083 
1084 void CheckBranchTargetConstraints(const SourceStmtList &stmts,
1085     const TargetStmtMap &labels, SemanticsContext &context) {
1086   for (const auto &stmt : stmts) {
1087     const auto &label{stmt.parserLabel};
1088     auto branchTarget{GetLabel(labels, label)};
1089     if (HasScope(branchTarget.proxyForScope)) {
1090       if (!branchTarget.labeledStmtClassificationSet.test(
1091               TargetStatementEnum::Branch) &&
1092           !branchTarget.labeledStmtClassificationSet.test(
1093               TargetStatementEnum::CompatibleBranch)) { // error
1094         context
1095             .Say(branchTarget.parserCharBlock,
1096                 "Label '%u' is not a branch target"_err_en_US, SayLabel(label))
1097             .Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US,
1098                 SayLabel(label));
1099       } else if (!branchTarget.labeledStmtClassificationSet.test(
1100                      TargetStatementEnum::Branch) &&
1101           context.ShouldWarn(common::LanguageFeature::BadBranchTarget)) {
1102         context
1103             .Say(branchTarget.parserCharBlock,
1104                 "Label '%u' is not a branch target"_warn_en_US, SayLabel(label))
1105             .Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US,
1106                 SayLabel(label))
1107             .set_languageFeature(common::LanguageFeature::BadBranchTarget);
1108       }
1109     }
1110   }
1111 }
1112 
1113 void CheckBranchConstraints(const SourceStmtList &branches,
1114     const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1115     SemanticsContext &context) {
1116   CheckScopeConstraints(branches, labels, scopes, context);
1117   CheckBranchTargetConstraints(branches, labels, context);
1118 }
1119 
1120 void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
1121     const TargetStmtMap &labels, SemanticsContext &context) {
1122   for (const auto &stmt : stmts) {
1123     const auto &label{stmt.parserLabel};
1124     auto ioTarget{GetLabel(labels, label)};
1125     if (HasScope(ioTarget.proxyForScope)) {
1126       if (!ioTarget.labeledStmtClassificationSet.test(
1127               TargetStatementEnum::Format)) {
1128         context
1129             .Say(ioTarget.parserCharBlock, "'%u' not a FORMAT"_err_en_US,
1130                 SayLabel(label))
1131             .Attach(stmt.parserCharBlock, "data transfer use of '%u'"_en_US,
1132                 SayLabel(label));
1133       }
1134     }
1135   }
1136 }
1137 
1138 void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
1139     const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1140     SemanticsContext &context) {
1141   CheckScopeConstraints(dataTransfers, labels, scopes, context);
1142   CheckDataXferTargetConstraints(dataTransfers, labels, context);
1143 }
1144 
1145 void CheckAssignTargetConstraints(const SourceStmtList &stmts,
1146     const TargetStmtMap &labels, SemanticsContext &context) {
1147   for (const auto &stmt : stmts) {
1148     const auto &label{stmt.parserLabel};
1149     auto target{GetLabel(labels, label)};
1150     if (HasScope(target.proxyForScope) &&
1151         !target.labeledStmtClassificationSet.test(
1152             TargetStatementEnum::Branch) &&
1153         !target.labeledStmtClassificationSet.test(
1154             TargetStatementEnum::Format)) {
1155       parser::Message *msg{nullptr};
1156       if (!target.labeledStmtClassificationSet.test(
1157               TargetStatementEnum::CompatibleBranch)) {
1158         msg = &context.Say(target.parserCharBlock,
1159             "Label '%u' is not a branch target or FORMAT"_err_en_US,
1160             SayLabel(label));
1161       } else if (context.ShouldWarn(common::LanguageFeature::BadBranchTarget)) {
1162         msg =
1163             &context
1164                  .Say(target.parserCharBlock,
1165                      "Label '%u' is not a branch target or FORMAT"_warn_en_US,
1166                      SayLabel(label))
1167                  .set_languageFeature(common::LanguageFeature::BadBranchTarget);
1168       }
1169       if (msg) {
1170         msg->Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US,
1171             SayLabel(label));
1172       }
1173     }
1174   }
1175 }
1176 
1177 void CheckAssignConstraints(const SourceStmtList &assigns,
1178     const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1179     SemanticsContext &context) {
1180   CheckScopeConstraints(assigns, labels, scopes, context);
1181   CheckAssignTargetConstraints(assigns, labels, context);
1182 }
1183 
1184 bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
1185   auto &context{parseTreeAnalysis.ErrorHandler()};
1186   for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
1187     const auto &dos{programUnit.doStmtSources};
1188     const auto &branches{programUnit.otherStmtSources};
1189     const auto &labels{programUnit.targetStmts};
1190     const auto &scopes{programUnit.scopeModel};
1191     CheckLabelDoConstraints(dos, branches, labels, scopes, context);
1192     CheckBranchConstraints(branches, labels, scopes, context);
1193     const auto &dataTransfers{programUnit.formatStmtSources};
1194     CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
1195     const auto &assigns{programUnit.assignStmtSources};
1196     CheckAssignConstraints(assigns, labels, scopes, context);
1197   }
1198   return !context.AnyFatalError();
1199 }
1200 
1201 bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
1202   return CheckConstraints(LabelAnalysis(context, program));
1203 }
1204 } // namespace Fortran::semantics
1205