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

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