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
17namespace Fortran::semantics {
18
19using namespace parser::literals;
20
21ENUM_CLASS(
22 TargetStatementEnum, Do, Branch, Format, CompatibleDo, CompatibleBranch)
23using LabeledStmtClassificationSet =
24 common::EnumSet<TargetStatementEnum, TargetStatementEnum_enumSize>;
25
26using 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.
29using ProxyForScope = unsigned;
30// Minimal scope information
31struct ScopeInfo {
32 ProxyForScope parent{};
33 bool isExteriorGotoFatal{false};
34 int depth{0};
35};
36struct LabeledStatementInfoTuplePOD {
37 ProxyForScope proxyForScope;
38 parser::CharBlock parserCharBlock;
39 LabeledStmtClassificationSet labeledStmtClassificationSet;
40 bool isExecutableConstructEndStmt;
41};
42using TargetStmtMap = std::map<parser::Label, LabeledStatementInfoTuplePOD>;
43struct 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};
53using SourceStmtList = std::vector<SourceStatementInfoTuplePOD>;
54enum class Legality { never, always, formerly };
55
56bool HasScope(ProxyForScope scope) { return scope != ProxyForScope{0u}; }
57
58// F18:R1131
59template <typename A>
60constexpr 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
75constexpr 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
100template <typename A> constexpr bool IsFormat(const parser::Statement<A> &) {
101 return std::is_same_v<A, common::Indirection<parser::FormatStmt>>;
102}
103
104template <typename A>
105constexpr 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
135template <typename A>
136constexpr 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
155static unsigned SayLabel(parser::Label label) {
156 return static_cast<unsigned>(label);
157}
158
159struct 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.
173template <typename A>
174const 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
197class ParseTreeAnalyzer {
198public:
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().isExteriorGotoFatal = 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(); }
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(); }
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(); }
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(); }
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
582private:
583 ScopeInfo &PushScope() {
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 currentScope_ = model.size() - 1;
590 return result;
591 }
592 bool InitializeNewScopeContext() {
593 programUnits_.emplace_back(UnitAnalysis{});
594 currentScope_ = 0u;
595 PushScope();
596 return true;
597 }
598 ScopeInfo &PopScope() {
599 ScopeInfo &result{programUnits_.back().scopeModel[currentScope_]};
600 currentScope_ = result.parent;
601 return result;
602 }
603 ProxyForScope ParentScope() {
604 return programUnits_.back().scopeModel[currentScope_].parent;
605 }
606 bool SwitchToNewScope() {
607 ScopeInfo &oldScope{PopScope()};
608 bool isExteriorGotoFatal{oldScope.isExteriorGotoFatal};
609 PushScope().isExteriorGotoFatal = isExteriorGotoFatal;
610 return true;
611 }
612
613 template <typename A> bool PushConstructName(const A &a) {
614 const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
615 if (optionalName) {
616 constructNames_.emplace_back(optionalName->ToString());
617 }
618 // Gotos into this construct from outside it are diagnosed, and
619 // are fatal unless the construct is a DO, IF, or SELECT CASE.
620 PushScope().isExteriorGotoFatal =
621 !(std::is_same_v<A, parser::DoConstruct> ||
622 std::is_same_v<A, parser::IfConstruct> ||
623 std::is_same_v<A, parser::CaseConstruct>);
624 return true;
625 }
626 bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
627 const auto &optionalName{
628 std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
629 .statement.v};
630 if (optionalName) {
631 constructNames_.emplace_back(optionalName->ToString());
632 }
633 PushScope().isExteriorGotoFatal = true;
634 return true;
635 }
636 template <typename A> void PopConstructNameIfPresent(const A &a) {
637 const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
638 if (optionalName) {
639 constructNames_.pop_back();
640 }
641 }
642 void PopConstructNameIfPresent(const parser::BlockConstruct &blockConstruct) {
643 const auto &optionalName{
644 std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
645 .statement.v};
646 if (optionalName) {
647 constructNames_.pop_back();
648 }
649 }
650
651 template <typename A> void PopConstructName(const A &a) {
652 CheckName(a);
653 PopScope();
654 PopConstructNameIfPresent(a);
655 }
656
657 template <typename FIRST, typename CASEBLOCK, typename CASE,
658 typename CONSTRUCT>
659 void CheckSelectNames(const char *tag, const CONSTRUCT &construct) {
660 CheckEndName<FIRST, parser::EndSelectStmt>(tag, construct);
661 for (const auto &inner : std::get<std::list<CASEBLOCK>>(construct.t)) {
662 CheckOptionalName<FIRST>(
663 tag, construct, std::get<parser::Statement<CASE>>(inner.t));
664 }
665 }
666
667 // C1144
668 void PopConstructName(const parser::CaseConstruct &caseConstruct) {
669 CheckSelectNames<parser::SelectCaseStmt, parser::CaseConstruct::Case,
670 parser::CaseStmt>("SELECT CASE", caseConstruct);
671 PopScope();
672 PopConstructNameIfPresent(caseConstruct);
673 }
674
675 // C1154, C1156
676 void PopConstructName(
677 const parser::SelectRankConstruct &selectRankConstruct) {
678 CheckSelectNames<parser::SelectRankStmt,
679 parser::SelectRankConstruct::RankCase, parser::SelectRankCaseStmt>(
680 "SELECT RANK", selectRankConstruct);
681 PopScope();
682 PopConstructNameIfPresent(selectRankConstruct);
683 }
684
685 // C1165
686 void PopConstructName(
687 const parser::SelectTypeConstruct &selectTypeConstruct) {
688 CheckSelectNames<parser::SelectTypeStmt,
689 parser::SelectTypeConstruct::TypeCase, parser::TypeGuardStmt>(
690 "SELECT TYPE", selectTypeConstruct);
691 PopScope();
692 PopConstructNameIfPresent(selectTypeConstruct);
693 }
694
695 // Checks for missing or mismatching names on various constructs (e.g., BLOCK)
696 // and their END statements. Both names must be present if either one is.
697 template <typename FIRST, typename END, typename CONSTRUCT>
698 void CheckEndName(const char *constructTag, const CONSTRUCT &a) {
699 const auto &constructStmt{std::get<parser::Statement<FIRST>>(a.t)};
700 const auto &endStmt{std::get<parser::Statement<END>>(a.t)};
701 const parser::CharBlock *endName{GetStmtName(endStmt)};
702 if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
703 if (endName) {
704 if (*constructName != *endName) {
705 context_
706 .Say(*endName, "%s construct name mismatch"_err_en_US,
707 constructTag)
708 .Attach(*constructName, "should be"_en_US);
709 }
710 } else {
711 context_
712 .Say(endStmt.source,
713 "%s construct name required but missing"_err_en_US,
714 constructTag)
715 .Attach(*constructName, "should be"_en_US);
716 }
717 } else if (endName) {
718 context_
719 .Say(*endName, "%s construct name unexpected"_err_en_US, constructTag)
720 .Attach(
721 constructStmt.source, "unnamed %s statement"_en_US, constructTag);
722 }
723 }
724
725 // C1106
726 void CheckName(const parser::AssociateConstruct &associateConstruct) {
727 CheckEndName<parser::AssociateStmt, parser::EndAssociateStmt>(
728 "ASSOCIATE", associateConstruct);
729 }
730 // C1117
731 void CheckName(const parser::CriticalConstruct &criticalConstruct) {
732 CheckEndName<parser::CriticalStmt, parser::EndCriticalStmt>(
733 "CRITICAL", criticalConstruct);
734 }
735 // C1131
736 void CheckName(const parser::DoConstruct &doConstruct) {
737 CheckEndName<parser::NonLabelDoStmt, parser::EndDoStmt>("DO", doConstruct);
738 if (auto label{std::get<std::optional<parser::Label>>(
739 std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)
740 .statement.t)}) {
741 const auto &endDoStmt{
742 std::get<parser::Statement<parser::EndDoStmt>>(doConstruct.t)};
743 if (!endDoStmt.label || *endDoStmt.label != *label) {
744 context_
745 .Say(endDoStmt.source,
746 "END DO statement must have the label '%d' matching its DO statement"_err_en_US,
747 *label)
748 .Attach(std::get<parser::Statement<parser::NonLabelDoStmt>>(
749 doConstruct.t)
750 .source,
751 "corresponding DO statement"_en_US);
752 }
753 }
754 }
755 // C1035
756 void CheckName(const parser::ForallConstruct &forallConstruct) {
757 CheckEndName<parser::ForallConstructStmt, parser::EndForallStmt>(
758 "FORALL", forallConstruct);
759 }
760
761 // C1109
762 void CheckName(const parser::BlockConstruct &blockConstruct) {
763 CheckEndName<parser::BlockStmt, parser::EndBlockStmt>(
764 "BLOCK", blockConstruct);
765 }
766 // C1112
767 void CheckName(const parser::ChangeTeamConstruct &changeTeamConstruct) {
768 CheckEndName<parser::ChangeTeamStmt, parser::EndChangeTeamStmt>(
769 "CHANGE TEAM", changeTeamConstruct);
770 }
771
772 // C1142
773 void CheckName(const parser::IfConstruct &ifConstruct) {
774 CheckEndName<parser::IfThenStmt, parser::EndIfStmt>("IF", ifConstruct);
775 for (const auto &elseIfBlock :
776 std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
777 CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
778 std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t));
779 }
780 if (const auto &elseBlock{
781 std::get<std::optional<parser::IfConstruct::ElseBlock>>(
782 ifConstruct.t)}) {
783 CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
784 std::get<parser::Statement<parser::ElseStmt>>(elseBlock->t));
785 }
786 }
787
788 // C1033
789 void CheckName(const parser::WhereConstruct &whereConstruct) {
790 CheckEndName<parser::WhereConstructStmt, parser::EndWhereStmt>(
791 "WHERE", whereConstruct);
792 for (const auto &maskedElsewhere :
793 std::get<std::list<parser::WhereConstruct::MaskedElsewhere>>(
794 whereConstruct.t)) {
795 CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
796 whereConstruct,
797 std::get<parser::Statement<parser::MaskedElsewhereStmt>>(
798 maskedElsewhere.t));
799 }
800 if (const auto &elsewhere{
801 std::get<std::optional<parser::WhereConstruct::Elsewhere>>(
802 whereConstruct.t)}) {
803 CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
804 whereConstruct,
805 std::get<parser::Statement<parser::ElsewhereStmt>>(elsewhere->t));
806 }
807 }
808
809 // C1134, C1166
810 void CheckLabelContext(
811 const char *const stmtString, const parser::CharBlock &constructName) {
812 const auto iter{std::find(constructNames_.crbegin(),
813 constructNames_.crend(), constructName.ToString())};
814 if (iter == constructNames_.crend()) {
815 context_.Say(constructName, "%s construct-name is not in scope"_err_en_US,
816 stmtString);
817 }
818 }
819
820 // 6.2.5, paragraph 2
821 void CheckLabelInRange(parser::Label label) {
822 if (label < 1 || label > 99999) {
823 context_.Say(currentPosition_, "Label '%u' is out of range"_err_en_US,
824 SayLabel(label));
825 }
826 }
827
828 // 6.2.5., paragraph 2
829 void AddTargetLabelDefinition(parser::Label label,
830 LabeledStmtClassificationSet labeledStmtClassificationSet,
831 ProxyForScope scope, bool isExecutableConstructEndStmt = false) {
832 CheckLabelInRange(label);
833 TargetStmtMap &targetStmtMap{disposableMaps_.empty()
834 ? programUnits_.back().targetStmts
835 : disposableMaps_.back()};
836 const auto pair{targetStmtMap.emplace(label,
837 LabeledStatementInfoTuplePOD{scope, currentPosition_,
838 labeledStmtClassificationSet, isExecutableConstructEndStmt})};
839 if (!pair.second) {
840 context_.Say(currentPosition_, "Label '%u' is not distinct"_err_en_US,
841 SayLabel(label));
842 }
843 }
844
845 void AddLabelReferenceFromDoStmt(parser::Label label) {
846 CheckLabelInRange(label);
847 programUnits_.back().doStmtSources.emplace_back(
848 label, currentScope_, currentPosition_);
849 }
850
851 void AddLabelReferenceToFormatStmt(parser::Label label) {
852 CheckLabelInRange(label);
853 programUnits_.back().formatStmtSources.emplace_back(
854 label, currentScope_, currentPosition_);
855 }
856
857 void AddLabelReferenceFromAssignStmt(parser::Label label) {
858 CheckLabelInRange(label);
859 programUnits_.back().assignStmtSources.emplace_back(
860 label, currentScope_, currentPosition_);
861 }
862
863 void AddLabelReference(parser::Label label) {
864 CheckLabelInRange(label);
865 programUnits_.back().otherStmtSources.emplace_back(
866 label, currentScope_, currentPosition_);
867 }
868
869 void AddLabelReference(const std::list<parser::Label> &labels) {
870 for (const parser::Label &label : labels) {
871 AddLabelReference(label);
872 }
873 }
874
875 void PushDisposableMap() { disposableMaps_.emplace_back(); }
876 void PopDisposableMap() { disposableMaps_.pop_back(); }
877
878 std::vector<UnitAnalysis> programUnits_;
879 SemanticsContext &context_;
880 parser::CharBlock currentPosition_;
881 ProxyForScope currentScope_;
882 std::vector<std::string> constructNames_;
883 // For labels in derived type definitions and procedure
884 // interfaces, which are their own inclusive scopes. None
885 // of these labels can be used as a branch target, but they
886 // should be pairwise distinct.
887 std::vector<TargetStmtMap> disposableMaps_;
888};
889
890bool InInclusiveScope(const std::vector<ScopeInfo> &scopes, ProxyForScope tail,
891 ProxyForScope head) {
892 for (; tail != head; tail = scopes[tail].parent) {
893 if (!HasScope(scope: tail)) {
894 return false;
895 }
896 }
897 return true;
898}
899
900ParseTreeAnalyzer LabelAnalysis(
901 SemanticsContext &context, const parser::Program &program) {
902 ParseTreeAnalyzer analysis{context};
903 Walk(program, analysis);
904 return analysis;
905}
906
907bool InBody(const parser::CharBlock &position,
908 const std::pair<parser::CharBlock, parser::CharBlock> &pair) {
909 if (position.begin() >= pair.first.begin()) {
910 if (position.begin() < pair.second.end()) {
911 return true;
912 }
913 }
914 return false;
915}
916
917LabeledStatementInfoTuplePOD GetLabel(
918 const TargetStmtMap &labels, const parser::Label &label) {
919 const auto iter{labels.find(label)};
920 if (iter == labels.cend()) {
921 return {0u, nullptr, LabeledStmtClassificationSet{}, false};
922 } else {
923 return iter->second;
924 }
925}
926
927// 11.1.7.3
928void CheckBranchesIntoDoBody(const SourceStmtList &branches,
929 const TargetStmtMap &labels, const IndexList &loopBodies,
930 SemanticsContext &context) {
931 for (const auto &branch : branches) {
932 const auto &label{branch.parserLabel};
933 auto branchTarget{GetLabel(labels, label)};
934 if (HasScope(branchTarget.proxyForScope)) {
935 const auto &fromPosition{branch.parserCharBlock};
936 const auto &toPosition{branchTarget.parserCharBlock};
937 for (const auto &body : loopBodies) {
938 if (!InBody(fromPosition, body) && InBody(toPosition, body)) {
939 context
940 .Say(
941 fromPosition, "branch into loop body from outside"_warn_en_US)
942 .Attach(body.first, "the loop branched into"_en_US);
943 }
944 }
945 }
946 }
947}
948
949void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
950 for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
951 const auto &v1{*i1};
952 for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
953 const auto &v2{*i2};
954 if (v2.first.begin() < v1.second.end() &&
955 v1.second.begin() < v2.second.begin()) {
956 context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
957 .Attach(v2.first, "DO loop conflicts"_en_US);
958 }
959 }
960 }
961}
962
963parser::CharBlock SkipLabel(const parser::CharBlock &position) {
964 const std::size_t maxPosition{position.size()};
965 if (maxPosition && parser::IsDecimalDigit(position[0])) {
966 std::size_t i{1l};
967 for (; (i < maxPosition) && parser::IsDecimalDigit(position[i]); ++i) {
968 }
969 for (; (i < maxPosition) && parser::IsWhiteSpace(position[i]); ++i) {
970 }
971 return parser::CharBlock{position.begin() + i, position.end()};
972 }
973 return position;
974}
975
976ProxyForScope ParentScope(
977 const std::vector<ScopeInfo> &scopes, ProxyForScope scope) {
978 return scopes[scope].parent;
979}
980
981void CheckLabelDoConstraints(const SourceStmtList &dos,
982 const SourceStmtList &branches, const TargetStmtMap &labels,
983 const std::vector<ScopeInfo> &scopes, SemanticsContext &context) {
984 IndexList loopBodies;
985 for (const auto &stmt : dos) {
986 const auto &label{stmt.parserLabel};
987 const auto &scope{stmt.proxyForScope};
988 const auto &position{stmt.parserCharBlock};
989 auto doTarget{GetLabel(labels, label)};
990 if (!HasScope(doTarget.proxyForScope)) {
991 // C1133
992 context.Say(
993 position, "Label '%u' cannot be found"_err_en_US, SayLabel(label));
994 } else if (doTarget.parserCharBlock.begin() < position.begin()) {
995 // R1119
996 context.Say(position,
997 "Label '%u' doesn't lexically follow DO stmt"_err_en_US,
998 SayLabel(label));
999
1000 } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
1001 doTarget.labeledStmtClassificationSet.test(
1002 TargetStatementEnum::CompatibleDo)) ||
1003 (doTarget.isExecutableConstructEndStmt &&
1004 ParentScope(scopes, doTarget.proxyForScope) == scope)) {
1005 if (context.ShouldWarn(
1006 common::LanguageFeature::OldLabelDoEndStatements)) {
1007 context
1008 .Say(position,
1009 "A DO loop should terminate with an END DO or CONTINUE"_port_en_US)
1010 .Attach(doTarget.parserCharBlock,
1011 "DO loop currently ends at statement:"_en_US);
1012 }
1013 } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
1014 context.Say(position, "Label '%u' is not in DO loop scope"_err_en_US,
1015 SayLabel(label));
1016 } else if (!doTarget.labeledStmtClassificationSet.test(
1017 TargetStatementEnum::Do)) {
1018 context.Say(doTarget.parserCharBlock,
1019 "A DO loop should terminate with an END DO or CONTINUE"_err_en_US);
1020 } else {
1021 loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
1022 }
1023 }
1024
1025 CheckBranchesIntoDoBody(branches, labels, loopBodies, context);
1026 CheckDoNesting(loopBodies, context);
1027}
1028
1029// 6.2.5
1030void CheckScopeConstraints(const SourceStmtList &stmts,
1031 const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1032 SemanticsContext &context) {
1033 for (const auto &stmt : stmts) {
1034 const auto &label{stmt.parserLabel};
1035 const auto &scope{stmt.proxyForScope};
1036 const auto &position{stmt.parserCharBlock};
1037 auto target{GetLabel(labels, label)};
1038 if (!HasScope(target.proxyForScope)) {
1039 context.Say(
1040 position, "Label '%u' was not found"_err_en_US, SayLabel(label));
1041 } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
1042 // Clause 11.1.2.1 prohibits transfer of control to the interior of a
1043 // block from outside the block, but this does not apply to formats.
1044 // C1038 and C1034 forbid statements in FORALL and WHERE constructs
1045 // (resp.) from being branch targets.
1046 if (target.labeledStmtClassificationSet.test(
1047 TargetStatementEnum::Format)) {
1048 continue;
1049 }
1050 bool isFatal{false};
1051 ProxyForScope fromScope{scope};
1052 for (ProxyForScope toScope{target.proxyForScope}; HasScope(toScope);
1053 toScope = scopes[toScope].parent) {
1054 while (scopes[fromScope].depth > scopes[toScope].depth) {
1055 fromScope = scopes[fromScope].parent;
1056 }
1057 if (toScope == fromScope) {
1058 break;
1059 }
1060 if (scopes[toScope].isExteriorGotoFatal) {
1061 isFatal = true;
1062 break;
1063 }
1064 }
1065 context.Say(position,
1066 isFatal
1067 ? "Label '%u' is in a construct that prevents its use as a branch target here"_err_en_US
1068 : "Label '%u' is in a construct that should not be used as a branch target here"_warn_en_US,
1069 SayLabel(label));
1070 }
1071 }
1072}
1073
1074void CheckBranchTargetConstraints(const SourceStmtList &stmts,
1075 const TargetStmtMap &labels, SemanticsContext &context) {
1076 for (const auto &stmt : stmts) {
1077 const auto &label{stmt.parserLabel};
1078 auto branchTarget{GetLabel(labels, label)};
1079 if (HasScope(branchTarget.proxyForScope)) {
1080 if (!branchTarget.labeledStmtClassificationSet.test(
1081 TargetStatementEnum::Branch) &&
1082 !branchTarget.labeledStmtClassificationSet.test(
1083 TargetStatementEnum::CompatibleBranch)) { // error
1084 context
1085 .Say(branchTarget.parserCharBlock,
1086 "Label '%u' is not a branch target"_err_en_US, SayLabel(label))
1087 .Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US,
1088 SayLabel(label));
1089 } else if (!branchTarget.labeledStmtClassificationSet.test(
1090 TargetStatementEnum::Branch)) { // warning
1091 context
1092 .Say(branchTarget.parserCharBlock,
1093 "Label '%u' is not a branch target"_warn_en_US, SayLabel(label))
1094 .Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US,
1095 SayLabel(label));
1096 }
1097 }
1098 }
1099}
1100
1101void CheckBranchConstraints(const SourceStmtList &branches,
1102 const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1103 SemanticsContext &context) {
1104 CheckScopeConstraints(branches, labels, scopes, context);
1105 CheckBranchTargetConstraints(branches, labels, context);
1106}
1107
1108void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
1109 const TargetStmtMap &labels, SemanticsContext &context) {
1110 for (const auto &stmt : stmts) {
1111 const auto &label{stmt.parserLabel};
1112 auto ioTarget{GetLabel(labels, label)};
1113 if (HasScope(ioTarget.proxyForScope)) {
1114 if (!ioTarget.labeledStmtClassificationSet.test(
1115 TargetStatementEnum::Format)) {
1116 context
1117 .Say(ioTarget.parserCharBlock, "'%u' not a FORMAT"_err_en_US,
1118 SayLabel(label))
1119 .Attach(stmt.parserCharBlock, "data transfer use of '%u'"_en_US,
1120 SayLabel(label));
1121 }
1122 }
1123 }
1124}
1125
1126void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
1127 const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1128 SemanticsContext &context) {
1129 CheckScopeConstraints(dataTransfers, labels, scopes, context);
1130 CheckDataXferTargetConstraints(dataTransfers, labels, context);
1131}
1132
1133void CheckAssignTargetConstraints(const SourceStmtList &stmts,
1134 const TargetStmtMap &labels, SemanticsContext &context) {
1135 for (const auto &stmt : stmts) {
1136 const auto &label{stmt.parserLabel};
1137 auto target{GetLabel(labels, label)};
1138 if (HasScope(target.proxyForScope) &&
1139 !target.labeledStmtClassificationSet.test(
1140 TargetStatementEnum::Branch) &&
1141 !target.labeledStmtClassificationSet.test(
1142 TargetStatementEnum::Format)) {
1143 context
1144 .Say(target.parserCharBlock,
1145 target.labeledStmtClassificationSet.test(
1146 TargetStatementEnum::CompatibleBranch)
1147 ? "Label '%u' is not a branch target or FORMAT"_warn_en_US
1148 : "Label '%u' is not a branch target or FORMAT"_err_en_US,
1149 SayLabel(label))
1150 .Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US,
1151 SayLabel(label));
1152 }
1153 }
1154}
1155
1156void CheckAssignConstraints(const SourceStmtList &assigns,
1157 const TargetStmtMap &labels, const std::vector<ScopeInfo> &scopes,
1158 SemanticsContext &context) {
1159 CheckScopeConstraints(assigns, labels, scopes, context);
1160 CheckAssignTargetConstraints(assigns, labels, context);
1161}
1162
1163bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
1164 auto &context{parseTreeAnalysis.ErrorHandler()};
1165 for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
1166 const auto &dos{programUnit.doStmtSources};
1167 const auto &branches{programUnit.otherStmtSources};
1168 const auto &labels{programUnit.targetStmts};
1169 const auto &scopes{programUnit.scopeModel};
1170 CheckLabelDoConstraints(dos, branches, labels, scopes, context);
1171 CheckBranchConstraints(branches, labels, scopes, context);
1172 const auto &dataTransfers{programUnit.formatStmtSources};
1173 CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
1174 const auto &assigns{programUnit.assignStmtSources};
1175 CheckAssignConstraints(assigns, labels, scopes, context);
1176 }
1177 return !context.AnyFatalError();
1178}
1179
1180bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
1181 return CheckConstraints(parseTreeAnalysis: LabelAnalysis(context, program));
1182}
1183} // namespace Fortran::semantics
1184

source code of flang/lib/Semantics/resolve-labels.cpp