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::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