flang/lib/Semantics/resolve-labels.cpp

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