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