1 // Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved.
2 //
3 // Licensed under the Apache License, Version 2.0 (the "License");
4 // you may not use this file except in compliance with the License.
5 // You may obtain a copy of the License at
6 //
7 // http://www.apache.org/licenses/LICENSE-2.0
8 //
9 // Unless required by applicable law or agreed to in writing, software
10 // distributed under the License is distributed on an "AS IS" BASIS,
11 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 // See the License for the specific language governing permissions and
13 // limitations under the License.
14
15 #include "resolve-labels.h"
16 #include "semantics.h"
17 #include "../common/enum-set.h"
18 #include "../common/template.h"
19 #include "../parser/parse-tree-visitor.h"
20 #include <cctype>
21 #include <cstdarg>
22 #include <type_traits>
23
24 namespace Fortran::semantics {
25
26 using namespace parser::literals;
27
28 ENUM_CLASS(
29 TargetStatementEnum, Do, Branch, Format, CompatibleDo, CompatibleBranch)
30 using LabeledStmtClassificationSet =
31 common::EnumSet<TargetStatementEnum, TargetStatementEnum_enumSize>;
32
33 using IndexList = std::vector<std::pair<parser::CharBlock, parser::CharBlock>>;
34 // A ProxyForScope is an integral proxy for a Fortran scope. This is required
35 // because the parse tree does not actually have the scopes required.
36 using ProxyForScope = unsigned;
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 {
SourceStatementInfoTuplePODFortran::semantics::SourceStatementInfoTuplePOD45 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
HasScope(ProxyForScope scope)57 bool HasScope(ProxyForScope scope) { return scope != ProxyForScope{0u}; }
58
59 // F18:R1131
60 template<typename A>
IsLegalDoTerm(const parser::Statement<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 there own scope.
70 return Legality::formerly;
71 } else {
72 return Legality::never;
73 }
74 }
75
IsLegalDoTerm(const parser::Statement<parser::ActionStmt> & actionStmt)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
IsFormat(const parser::Statement<A> &)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>
IsLegalBranchTarget(const parser::Statement<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>
ConstructBranchTargetFlags(const parser::Statement<A> & statement)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
SayLabel(parser::Label label)157 static unsigned SayLabel(parser::Label label) {
158 return static_cast<unsigned>(label);
159 }
160
161 struct UnitAnalysis {
UnitAnalysisFortran::semantics::UnitAnalysis162 UnitAnalysis() { scopeModel.push_back(0); }
UnitAnalysisFortran::semantics::UnitAnalysis163 UnitAnalysis(UnitAnalysis &&that)
164 : doStmtSources{std::move(that.doStmtSources)},
165 formatStmtSources{std::move(that.formatStmtSources)},
166 otherStmtSources{std::move(that.otherStmtSources)},
167 targetStmts{std::move(that.targetStmts)}, scopeModel{std::move(
168 that.scopeModel)} {}
169
170 SourceStmtList doStmtSources;
171 SourceStmtList formatStmtSources;
172 SourceStmtList otherStmtSources;
173 TargetStmtMap targetStmts;
174 std::vector<ProxyForScope> scopeModel;
175 };
176
177 // Some parse tree record for statements simply wrap construct names;
178 // others include them as tuple components. Given a statement,
179 // return a pointer to its name if it has one.
180 template<typename A>
GetStmtName(const parser::Statement<A> & stmt)181 const parser::CharBlock *GetStmtName(const parser::Statement<A> &stmt) {
182 const std::optional<parser::Name> *name{nullptr};
183 if constexpr (WrapperTrait<A>) {
184 if constexpr (std::is_same_v<decltype(A::v), parser::Name>) {
185 return &stmt.statement.v.source;
186 } else {
187 name = &stmt.statement.v;
188 }
189 } else if constexpr (std::is_same_v<A, parser::SelectRankStmt> ||
190 std::is_same_v<A, parser::SelectTypeStmt>) {
191 name = &std::get<0>(stmt.statement.t);
192 } else if constexpr (common::HasMember<parser::Name,
193 decltype(stmt.statement.t)>) {
194 return &std::get<parser::Name>(stmt.statement.t).source;
195 } else {
196 name = &std::get<std::optional<parser::Name>>(stmt.statement.t);
197 }
198 if (name && name->has_value()) {
199 return &(*name)->source;
200 }
201 return nullptr;
202 }
203
204 using ExecutableConstructEndStmts = std::tuple<parser::EndIfStmt,
205 parser::EndDoStmt, parser::EndSelectStmt, parser::EndChangeTeamStmt,
206 parser::EndBlockStmt, parser::EndCriticalStmt, parser::EndAssociateStmt>;
207
208 template<typename A>
209 static constexpr bool IsExecutableConstructEndStmt{
210 common::HasMember<A, ExecutableConstructEndStmts>};
211
212 class ParseTreeAnalyzer {
213 public:
214 ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default;
ParseTreeAnalyzer(SemanticsContext & context)215 ParseTreeAnalyzer(SemanticsContext &context) : context_{context} {}
216
Pre(const A &)217 template<typename A> constexpr bool Pre(const A &) { return true; }
Post(const A &)218 template<typename A> constexpr void Post(const A &) {}
219
Pre(const parser::Statement<A> & statement)220 template<typename A> bool Pre(const parser::Statement<A> &statement) {
221 currentPosition_ = statement.source;
222 if (statement.label.has_value()) {
223 auto label{statement.label.value()};
224 auto targetFlags{ConstructBranchTargetFlags(statement)};
225 if constexpr (std::is_same_v<A, parser::AssociateStmt> ||
226 std::is_same_v<A, parser::BlockStmt> ||
227 std::is_same_v<A, parser::ChangeTeamStmt> ||
228 std::is_same_v<A, parser::CriticalStmt> ||
229 std::is_same_v<A, parser::NonLabelDoStmt> ||
230 std::is_same_v<A, parser::IfThenStmt> ||
231 std::is_same_v<A, parser::SelectCaseStmt> ||
232 std::is_same_v<A, parser::SelectRankStmt> ||
233 std::is_same_v<A, parser::SelectTypeStmt>) {
234 constexpr bool useParent{true};
235 AddTargetLabelDefinition(
236 useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
237 } else {
238 constexpr bool useParent{false};
239 AddTargetLabelDefinition(
240 useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
241 }
242 }
243 return true;
244 }
245
246 // see 11.1.1
Pre(const parser::ProgramUnit &)247 bool Pre(const parser::ProgramUnit &) { return InitializeNewScopeContext(); }
Pre(const parser::InternalSubprogram &)248 bool Pre(const parser::InternalSubprogram &) {
249 return InitializeNewScopeContext();
250 }
Pre(const parser::ModuleSubprogram &)251 bool Pre(const parser::ModuleSubprogram &) {
252 return InitializeNewScopeContext();
253 }
Pre(const parser::AssociateConstruct & associateConstruct)254 bool Pre(const parser::AssociateConstruct &associateConstruct) {
255 return PushConstructName(associateConstruct);
256 }
Pre(const parser::BlockConstruct & blockConstruct)257 bool Pre(const parser::BlockConstruct &blockConstruct) {
258 return PushConstructName(blockConstruct);
259 }
Pre(const parser::ChangeTeamConstruct & changeTeamConstruct)260 bool Pre(const parser::ChangeTeamConstruct &changeTeamConstruct) {
261 return PushConstructName(changeTeamConstruct);
262 }
Pre(const parser::CriticalConstruct & criticalConstruct)263 bool Pre(const parser::CriticalConstruct &criticalConstruct) {
264 return PushConstructName(criticalConstruct);
265 }
Pre(const parser::DoConstruct & doConstruct)266 bool Pre(const parser::DoConstruct &doConstruct) {
267 return PushConstructName(doConstruct);
268 }
Pre(const parser::IfConstruct & ifConstruct)269 bool Pre(const parser::IfConstruct &ifConstruct) {
270 return PushConstructName(ifConstruct);
271 }
Pre(const parser::IfConstruct::ElseIfBlock &)272 bool Pre(const parser::IfConstruct::ElseIfBlock &) {
273 return SwitchToNewScope();
274 }
Pre(const parser::IfConstruct::ElseBlock &)275 bool Pre(const parser::IfConstruct::ElseBlock &) {
276 return SwitchToNewScope();
277 }
Pre(const parser::CaseConstruct & caseConstruct)278 bool Pre(const parser::CaseConstruct &caseConstruct) {
279 return PushConstructName(caseConstruct);
280 }
Pre(const parser::CaseConstruct::Case &)281 bool Pre(const parser::CaseConstruct::Case &) { return SwitchToNewScope(); }
Pre(const parser::SelectRankConstruct & selectRankConstruct)282 bool Pre(const parser::SelectRankConstruct &selectRankConstruct) {
283 return PushConstructName(selectRankConstruct);
284 }
Pre(const parser::SelectRankConstruct::RankCase &)285 bool Pre(const parser::SelectRankConstruct::RankCase &) {
286 return SwitchToNewScope();
287 }
Pre(const parser::SelectTypeConstruct & selectTypeConstruct)288 bool Pre(const parser::SelectTypeConstruct &selectTypeConstruct) {
289 return PushConstructName(selectTypeConstruct);
290 }
Pre(const parser::SelectTypeConstruct::TypeCase &)291 bool Pre(const parser::SelectTypeConstruct::TypeCase &) {
292 return SwitchToNewScope();
293 }
Pre(const parser::WhereConstruct & whereConstruct)294 bool Pre(const parser::WhereConstruct &whereConstruct) {
295 return PushConstructNameWithoutBlock(whereConstruct);
296 }
Pre(const parser::ForallConstruct & forallConstruct)297 bool Pre(const parser::ForallConstruct &forallConstruct) {
298 return PushConstructNameWithoutBlock(forallConstruct);
299 }
300
Post(const parser::AssociateConstruct & associateConstruct)301 void Post(const parser::AssociateConstruct &associateConstruct) {
302 PopConstructName(associateConstruct);
303 }
Post(const parser::BlockConstruct & blockConstruct)304 void Post(const parser::BlockConstruct &blockConstruct) {
305 PopConstructName(blockConstruct);
306 }
Post(const parser::ChangeTeamConstruct & changeTeamConstruct)307 void Post(const parser::ChangeTeamConstruct &changeTeamConstruct) {
308 PopConstructName(changeTeamConstruct);
309 }
Post(const parser::CriticalConstruct & criticalConstruct)310 void Post(const parser::CriticalConstruct &criticalConstruct) {
311 PopConstructName(criticalConstruct);
312 }
Post(const parser::DoConstruct & doConstruct)313 void Post(const parser::DoConstruct &doConstruct) {
314 PopConstructName(doConstruct);
315 }
Post(const parser::IfConstruct & ifConstruct)316 void Post(const parser::IfConstruct &ifConstruct) {
317 PopConstructName(ifConstruct);
318 }
Post(const parser::CaseConstruct & caseConstruct)319 void Post(const parser::CaseConstruct &caseConstruct) {
320 PopConstructName(caseConstruct);
321 }
Post(const parser::SelectRankConstruct & selectRankConstruct)322 void Post(const parser::SelectRankConstruct &selectRankConstruct) {
323 PopConstructName(selectRankConstruct);
324 }
Post(const parser::SelectTypeConstruct & selectTypeConstruct)325 void Post(const parser::SelectTypeConstruct &selectTypeConstruct) {
326 PopConstructName(selectTypeConstruct);
327 }
328
Post(const parser::WhereConstruct & whereConstruct)329 void Post(const parser::WhereConstruct &whereConstruct) {
330 PopConstructNameWithoutBlock(whereConstruct);
331 }
Post(const parser::ForallConstruct & forallConstruct)332 void Post(const parser::ForallConstruct &forallConstruct) {
333 PopConstructNameWithoutBlock(forallConstruct);
334 }
335
336 // Checks for missing or mismatching names on various constructs (e.g., IF)
337 // and their intermediate or terminal statements that allow optional
338 // construct names(e.g., ELSE). When an optional construct name is present,
339 // the construct as a whole must have a name that matches.
340 template<typename FIRST, typename CONSTRUCT, typename STMT>
CheckOptionalName(const char * constructTag,const CONSTRUCT & a,const parser::Statement<STMT> & stmt)341 void CheckOptionalName(const char *constructTag, const CONSTRUCT &a,
342 const parser::Statement<STMT> &stmt) {
343 if (const parser::CharBlock * name{GetStmtName(stmt)}) {
344 const auto &firstStmt{std::get<parser::Statement<FIRST>>(a.t)};
345 if (const parser::CharBlock * firstName{GetStmtName(firstStmt)}) {
346 if (*firstName != *name) {
347 context_
348 .Say(*name,
349 parser::MessageFormattedText{
350 "%s name mismatch"_err_en_US, constructTag})
351 .Attach(*firstName, "should be"_en_US);
352 }
353 } else {
354 context_
355 .Say(*name,
356 parser::MessageFormattedText{
357 "%s name not allowed"_err_en_US, constructTag})
358 .Attach(firstStmt.source, "in unnamed %s"_en_US, constructTag);
359 }
360 }
361 }
362
363 // C1414
Post(const parser::BlockData & blockData)364 void Post(const parser::BlockData &blockData) {
365 CheckOptionalName<parser::BlockDataStmt>("BLOCK DATA subprogram", blockData,
366 std::get<parser::Statement<parser::EndBlockDataStmt>>(blockData.t));
367 }
368
369 // C1564
Post(const parser::FunctionSubprogram & functionSubprogram)370 void Post(const parser::FunctionSubprogram &functionSubprogram) {
371 CheckOptionalName<parser::FunctionStmt>("FUNCTION", functionSubprogram,
372 std::get<parser::Statement<parser::EndFunctionStmt>>(
373 functionSubprogram.t));
374 }
Post(const parser::InterfaceBlock & interfaceBlock)375 void Post(const parser::InterfaceBlock &interfaceBlock) {
376 auto &interfaceStmt{
377 std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t)};
378 if (const auto *optionalGenericSpecPointer{
379 std::get_if<std::optional<parser::GenericSpec>>(
380 &interfaceStmt.statement.u)}) {
381 if (optionalGenericSpecPointer->has_value()) {
382 if (const auto *namePointer{
383 std::get_if<parser::Name>(&(*optionalGenericSpecPointer)->u)}) {
384 auto &optionalGenericSpec{
385 std::get<parser::Statement<parser::EndInterfaceStmt>>(
386 interfaceBlock.t)
387 .statement.v};
388 if (optionalGenericSpec.has_value()) {
389 if (const auto *otherPointer{
390 std::get_if<parser::Name>(&optionalGenericSpec->u)}) {
391 if (namePointer->source != otherPointer->source) {
392 context_
393 .Say(currentPosition_,
394 parser::MessageFormattedText{
395 "INTERFACE generic-name (%s) mismatch"_en_US,
396 namePointer->source})
397 .Attach(interfaceStmt.source, "mismatched INTERFACE"_en_US);
398 }
399 }
400 }
401 }
402 }
403 }
404 }
405
406 // C1402
Post(const parser::Module & module)407 void Post(const parser::Module &module) {
408 CheckOptionalName<parser::ModuleStmt>("MODULE", module,
409 std::get<parser::Statement<parser::EndModuleStmt>>(module.t));
410 }
411
412 // C1569
Post(const parser::SeparateModuleSubprogram & separateModuleSubprogram)413 void Post(const parser::SeparateModuleSubprogram &separateModuleSubprogram) {
414 CheckOptionalName<parser::MpSubprogramStmt>("MODULE PROCEDURE",
415 separateModuleSubprogram,
416 std::get<parser::Statement<parser::EndMpSubprogramStmt>>(
417 separateModuleSubprogram.t));
418 }
419
420 // C1401
Post(const parser::MainProgram & mainProgram)421 void Post(const parser::MainProgram &mainProgram) {
422 if (const parser::CharBlock *
423 endName{GetStmtName(std::get<parser::Statement<parser::EndProgramStmt>>(
424 mainProgram.t))}) {
425 if (const auto &program{
426 std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(
427 mainProgram.t)}) {
428 if (*endName != program->statement.v.source) {
429 context_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
430 .Attach(program->statement.v.source, "should be"_en_US);
431 }
432 } else {
433 context_.Say(*endName,
434 parser::MessageFormattedText{
435 "END PROGRAM has name without PROGRAM statement"_err_en_US});
436 }
437 }
438 }
439
440 // C1413
Post(const parser::Submodule & submodule)441 void Post(const parser::Submodule &submodule) {
442 CheckOptionalName<parser::SubmoduleStmt>("SUBMODULE", submodule,
443 std::get<parser::Statement<parser::EndSubmoduleStmt>>(submodule.t));
444 }
445
446 // C1567
Post(const parser::SubroutineSubprogram & subroutineSubprogram)447 void Post(const parser::SubroutineSubprogram &subroutineSubprogram) {
448 CheckOptionalName<parser::SubroutineStmt>("SUBROUTINE",
449 subroutineSubprogram,
450 std::get<parser::Statement<parser::EndSubroutineStmt>>(
451 subroutineSubprogram.t));
452 }
453
454 // C739
Post(const parser::DerivedTypeDef & derivedTypeDef)455 void Post(const parser::DerivedTypeDef &derivedTypeDef) {
456 CheckOptionalName<parser::DerivedTypeStmt>("derived type definition",
457 derivedTypeDef,
458 std::get<parser::Statement<parser::EndTypeStmt>>(derivedTypeDef.t));
459 }
460
Post(const parser::LabelDoStmt & labelDoStmt)461 void Post(const parser::LabelDoStmt &labelDoStmt) {
462 AddLabelReferenceFromDoStmt(std::get<parser::Label>(labelDoStmt.t));
463 }
Post(const parser::GotoStmt & gotoStmt)464 void Post(const parser::GotoStmt &gotoStmt) { AddLabelReference(gotoStmt.v); }
Post(const parser::ComputedGotoStmt & computedGotoStmt)465 void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
466 AddLabelReference(std::get<std::list<parser::Label>>(computedGotoStmt.t));
467 }
Post(const parser::ArithmeticIfStmt & arithmeticIfStmt)468 void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
469 AddLabelReference(std::get<1>(arithmeticIfStmt.t));
470 AddLabelReference(std::get<2>(arithmeticIfStmt.t));
471 AddLabelReference(std::get<3>(arithmeticIfStmt.t));
472 }
Post(const parser::AssignStmt & assignStmt)473 void Post(const parser::AssignStmt &assignStmt) {
474 AddLabelReference(std::get<parser::Label>(assignStmt.t));
475 }
Post(const parser::AssignedGotoStmt & assignedGotoStmt)476 void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
477 AddLabelReference(std::get<std::list<parser::Label>>(assignedGotoStmt.t));
478 }
Post(const parser::AltReturnSpec & altReturnSpec)479 void Post(const parser::AltReturnSpec &altReturnSpec) {
480 AddLabelReference(altReturnSpec.v);
481 }
482
Post(const parser::ErrLabel & errLabel)483 void Post(const parser::ErrLabel &errLabel) { AddLabelReference(errLabel.v); }
Post(const parser::EndLabel & endLabel)484 void Post(const parser::EndLabel &endLabel) { AddLabelReference(endLabel.v); }
Post(const parser::EorLabel & eorLabel)485 void Post(const parser::EorLabel &eorLabel) { AddLabelReference(eorLabel.v); }
Post(const parser::Format & format)486 void Post(const parser::Format &format) {
487 if (const auto *labelPointer{std::get_if<parser::Label>(&format.u)}) {
488 AddLabelReferenceToFormatStmt(*labelPointer);
489 }
490 }
Post(const parser::CycleStmt & cycleStmt)491 void Post(const parser::CycleStmt &cycleStmt) {
492 if (cycleStmt.v.has_value()) {
493 CheckLabelContext("CYCLE", cycleStmt.v->source);
494 }
495 }
Post(const parser::ExitStmt & exitStmt)496 void Post(const parser::ExitStmt &exitStmt) {
497 if (exitStmt.v.has_value()) {
498 CheckLabelContext("EXIT", exitStmt.v->source);
499 }
500 }
501
ProgramUnits() const502 const std::vector<UnitAnalysis> &ProgramUnits() const {
503 return programUnits_;
504 }
ErrorHandler()505 SemanticsContext &ErrorHandler() { return context_; }
506
507 private:
PushSubscope()508 bool PushSubscope() {
509 programUnits_.back().scopeModel.push_back(currentScope_);
510 currentScope_ = programUnits_.back().scopeModel.size() - 1;
511 return true;
512 }
InitializeNewScopeContext()513 bool InitializeNewScopeContext() {
514 programUnits_.emplace_back(UnitAnalysis{});
515 currentScope_ = 0u;
516 return PushSubscope();
517 }
PopScope()518 void PopScope() {
519 currentScope_ = programUnits_.back().scopeModel[currentScope_];
520 }
ParentScope()521 ProxyForScope ParentScope() {
522 return programUnits_.back().scopeModel[currentScope_];
523 }
SwitchToNewScope()524 bool SwitchToNewScope() {
525 PopScope();
526 return PushSubscope();
527 }
528
PushConstructName(const A & a)529 template<typename A> bool PushConstructName(const A &a) {
530 const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
531 if (optionalName.has_value()) {
532 constructNames_.emplace_back(optionalName->ToString());
533 }
534 return PushSubscope();
535 }
PushConstructName(const parser::BlockConstruct & blockConstruct)536 bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
537 const auto &optionalName{
538 std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
539 .statement.v};
540 if (optionalName.has_value()) {
541 constructNames_.emplace_back(optionalName->ToString());
542 }
543 return PushSubscope();
544 }
PushConstructNameWithoutBlock(const A & a)545 template<typename A> bool PushConstructNameWithoutBlock(const A &a) {
546 const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
547 if (optionalName.has_value()) {
548 constructNames_.emplace_back(optionalName->ToString());
549 }
550 return true;
551 }
552
PopConstructNameWithoutBlock(const A & a)553 template<typename A> void PopConstructNameWithoutBlock(const A &a) {
554 CheckName(a);
555 PopConstructNameIfPresent(a);
556 }
PopConstructNameIfPresent(const A & a)557 template<typename A> void PopConstructNameIfPresent(const A &a) {
558 const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
559 if (optionalName.has_value()) {
560 constructNames_.pop_back();
561 }
562 }
PopConstructNameIfPresent(const parser::BlockConstruct & blockConstruct)563 void PopConstructNameIfPresent(const parser::BlockConstruct &blockConstruct) {
564 const auto &optionalName{
565 std::get<parser::Statement<parser::BlockStmt>>(blockConstruct.t)
566 .statement.v};
567 if (optionalName.has_value()) {
568 constructNames_.pop_back();
569 }
570 }
571
PopConstructName(const A & a)572 template<typename A> void PopConstructName(const A &a) {
573 CheckName(a);
574 PopScope();
575 PopConstructNameIfPresent(a);
576 }
577
578 template<typename FIRST, typename CASEBLOCK, typename CASE,
579 typename CONSTRUCT>
CheckSelectNames(const char * tag,const CONSTRUCT & construct)580 void CheckSelectNames(const char *tag, const CONSTRUCT &construct) {
581 CheckEndName<FIRST, parser::EndSelectStmt>(tag, construct);
582 for (const auto &inner : std::get<std::list<CASEBLOCK>>(construct.t)) {
583 CheckOptionalName<FIRST>(
584 tag, construct, std::get<parser::Statement<CASE>>(inner.t));
585 }
586 }
587
588 // C1144
PopConstructName(const parser::CaseConstruct & caseConstruct)589 void PopConstructName(const parser::CaseConstruct &caseConstruct) {
590 CheckSelectNames<parser::SelectCaseStmt, parser::CaseConstruct::Case,
591 parser::CaseStmt>("SELECT CASE", caseConstruct);
592 PopScope();
593 PopConstructNameIfPresent(caseConstruct);
594 }
595
596 // C1154, C1156
PopConstructName(const parser::SelectRankConstruct & selectRankConstruct)597 void PopConstructName(
598 const parser::SelectRankConstruct &selectRankConstruct) {
599 CheckSelectNames<parser::SelectRankStmt,
600 parser::SelectRankConstruct::RankCase, parser::SelectRankCaseStmt>(
601 "SELECT RANK", selectRankConstruct);
602 PopScope();
603 PopConstructNameIfPresent(selectRankConstruct);
604 }
605
606 // C1165
PopConstructName(const parser::SelectTypeConstruct & selectTypeConstruct)607 void PopConstructName(
608 const parser::SelectTypeConstruct &selectTypeConstruct) {
609 CheckSelectNames<parser::SelectTypeStmt,
610 parser::SelectTypeConstruct::TypeCase, parser::TypeGuardStmt>(
611 "SELECT TYPE", selectTypeConstruct);
612 PopScope();
613 PopConstructNameIfPresent(selectTypeConstruct);
614 }
615
616 // Checks for missing or mismatching names on various constructs (e.g., BLOCK)
617 // and their END statements. Both names must be present if either one is.
618 template<typename FIRST, typename END, typename CONSTRUCT>
CheckEndName(const char * constructTag,const CONSTRUCT & a)619 void CheckEndName(const char *constructTag, const CONSTRUCT &a) {
620 const auto &constructStmt{std::get<parser::Statement<FIRST>>(a.t)};
621 const auto &endStmt{std::get<parser::Statement<END>>(a.t)};
622 const parser::CharBlock *endName{GetStmtName(endStmt)};
623 if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
624 if (endName) {
625 if (*constructName != *endName) {
626 context_
627 .Say(*endName,
628 parser::MessageFormattedText{
629 "%s construct name mismatch"_err_en_US, constructTag})
630 .Attach(*constructName, "should be"_en_US);
631 }
632 } else {
633 context_
634 .Say(endStmt.source,
635 parser::MessageFormattedText{
636 "%s construct name required but missing"_err_en_US,
637 constructTag})
638 .Attach(*constructName, "should be"_en_US);
639 }
640 } else if (endName) {
641 context_
642 .Say(*endName,
643 parser::MessageFormattedText{
644 "%s construct name unexpected"_err_en_US, constructTag})
645 .Attach(
646 constructStmt.source, "unnamed %s statement"_en_US, constructTag);
647 }
648 }
649
650 // C1106
CheckName(const parser::AssociateConstruct & associateConstruct)651 void CheckName(const parser::AssociateConstruct &associateConstruct) {
652 CheckEndName<parser::AssociateStmt, parser::EndAssociateStmt>(
653 "ASSOCIATE", associateConstruct);
654 }
655 // C1117
CheckName(const parser::CriticalConstruct & criticalConstruct)656 void CheckName(const parser::CriticalConstruct &criticalConstruct) {
657 CheckEndName<parser::CriticalStmt, parser::EndCriticalStmt>(
658 "CRITICAL", criticalConstruct);
659 }
660 // C1131
CheckName(const parser::DoConstruct & doConstruct)661 void CheckName(const parser::DoConstruct &doConstruct) {
662 CheckEndName<parser::NonLabelDoStmt, parser::EndDoStmt>("DO", doConstruct);
663 }
664 // C1035
CheckName(const parser::ForallConstruct & forallConstruct)665 void CheckName(const parser::ForallConstruct &forallConstruct) {
666 CheckEndName<parser::ForallConstructStmt, parser::EndForallStmt>(
667 "FORALL", forallConstruct);
668 }
669
670 // C1109
CheckName(const parser::BlockConstruct & blockConstruct)671 void CheckName(const parser::BlockConstruct &blockConstruct) {
672 CheckEndName<parser::BlockStmt, parser::EndBlockStmt>(
673 "BLOCK", blockConstruct);
674 }
675 // C1112
CheckName(const parser::ChangeTeamConstruct & changeTeamConstruct)676 void CheckName(const parser::ChangeTeamConstruct &changeTeamConstruct) {
677 CheckEndName<parser::ChangeTeamStmt, parser::EndChangeTeamStmt>(
678 "CHANGE TEAM", changeTeamConstruct);
679 }
680
681 // C1142
CheckName(const parser::IfConstruct & ifConstruct)682 void CheckName(const parser::IfConstruct &ifConstruct) {
683 CheckEndName<parser::IfThenStmt, parser::EndIfStmt>("IF", ifConstruct);
684 for (const auto &elseIfBlock :
685 std::get<std::list<parser::IfConstruct::ElseIfBlock>>(ifConstruct.t)) {
686 CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
687 std::get<parser::Statement<parser::ElseIfStmt>>(elseIfBlock.t));
688 }
689 if (const auto &elseBlock{
690 std::get<std::optional<parser::IfConstruct::ElseBlock>>(
691 ifConstruct.t)}) {
692 CheckOptionalName<parser::IfThenStmt>("IF construct", ifConstruct,
693 std::get<parser::Statement<parser::ElseStmt>>(elseBlock->t));
694 }
695 }
696
697 // C1033
CheckName(const parser::WhereConstruct & whereConstruct)698 void CheckName(const parser::WhereConstruct &whereConstruct) {
699 CheckEndName<parser::WhereConstructStmt, parser::EndWhereStmt>(
700 "WHERE", whereConstruct);
701 for (const auto &maskedElsewhere :
702 std::get<std::list<parser::WhereConstruct::MaskedElsewhere>>(
703 whereConstruct.t)) {
704 CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
705 whereConstruct,
706 std::get<parser::Statement<parser::MaskedElsewhereStmt>>(
707 maskedElsewhere.t));
708 }
709 if (const auto &elsewhere{
710 std::get<std::optional<parser::WhereConstruct::Elsewhere>>(
711 whereConstruct.t)}) {
712 CheckOptionalName<parser::WhereConstructStmt>("WHERE construct",
713 whereConstruct,
714 std::get<parser::Statement<parser::ElsewhereStmt>>(elsewhere->t));
715 }
716 }
717
718 // C1134, C1166
CheckLabelContext(const char * const stmtString,const parser::CharBlock & constructName)719 void CheckLabelContext(
720 const char *const stmtString, const parser::CharBlock &constructName) {
721 const auto iter{std::find(constructNames_.crbegin(),
722 constructNames_.crend(), constructName.ToString())};
723 if (iter == constructNames_.crend()) {
724 context_.Say(constructName,
725 parser::MessageFormattedText{
726 "%s construct-name is not in scope"_err_en_US, stmtString});
727 }
728 }
729
730 // 6.2.5, paragraph 2
CheckLabelInRange(parser::Label label)731 void CheckLabelInRange(parser::Label label) {
732 if (label < 1 || label > 99999) {
733 context_.Say(currentPosition_,
734 parser::MessageFormattedText{
735 "label '%u' is out of range"_err_en_US, SayLabel(label)});
736 }
737 }
738
739 // 6.2.5., paragraph 2
AddTargetLabelDefinition(bool useParent,parser::Label label,LabeledStmtClassificationSet labeledStmtClassificationSet,bool isExecutableConstructEndStmt)740 void AddTargetLabelDefinition(bool useParent, parser::Label label,
741 LabeledStmtClassificationSet labeledStmtClassificationSet,
742 bool isExecutableConstructEndStmt) {
743 CheckLabelInRange(label);
744 const auto pair{programUnits_.back().targetStmts.emplace(label,
745 LabeledStatementInfoTuplePOD{
746 (useParent ? ParentScope() : currentScope_), currentPosition_,
747 labeledStmtClassificationSet, isExecutableConstructEndStmt})};
748 if (!pair.second) {
749 context_.Say(currentPosition_,
750 parser::MessageFormattedText{
751 "label '%u' is not distinct"_err_en_US, SayLabel(label)});
752 }
753 }
754
AddLabelReferenceFromDoStmt(parser::Label label)755 void AddLabelReferenceFromDoStmt(parser::Label label) {
756 CheckLabelInRange(label);
757 programUnits_.back().doStmtSources.emplace_back(
758 label, currentScope_, currentPosition_);
759 }
760
AddLabelReferenceToFormatStmt(parser::Label label)761 void AddLabelReferenceToFormatStmt(parser::Label label) {
762 CheckLabelInRange(label);
763 programUnits_.back().formatStmtSources.emplace_back(
764 label, currentScope_, currentPosition_);
765 }
766
AddLabelReference(parser::Label label)767 void AddLabelReference(parser::Label label) {
768 CheckLabelInRange(label);
769 programUnits_.back().otherStmtSources.emplace_back(
770 label, currentScope_, currentPosition_);
771 }
772
AddLabelReference(const std::list<parser::Label> & labels)773 void AddLabelReference(const std::list<parser::Label> &labels) {
774 for (const parser::Label &label : labels) {
775 AddLabelReference(label);
776 }
777 }
778
779 std::vector<UnitAnalysis> programUnits_;
780 SemanticsContext &context_;
781 parser::CharBlock currentPosition_{nullptr};
782 ProxyForScope currentScope_;
783 std::vector<std::string> constructNames_;
784 };
785
InInclusiveScope(const std::vector<ProxyForScope> & scopes,ProxyForScope tail,ProxyForScope head)786 bool InInclusiveScope(const std::vector<ProxyForScope> &scopes,
787 ProxyForScope tail, ProxyForScope head) {
788 for (; tail != head; tail = scopes[tail]) {
789 if (!HasScope(tail)) {
790 return false;
791 }
792 }
793 return true;
794 }
795
LabelAnalysis(SemanticsContext & context,const parser::Program & program)796 ParseTreeAnalyzer LabelAnalysis(
797 SemanticsContext &context, const parser::Program &program) {
798 ParseTreeAnalyzer analysis{context};
799 Walk(program, analysis);
800 return analysis;
801 }
802
InBody(const parser::CharBlock & position,const std::pair<parser::CharBlock,parser::CharBlock> & pair)803 bool InBody(const parser::CharBlock &position,
804 const std::pair<parser::CharBlock, parser::CharBlock> &pair) {
805 if (position.begin() >= pair.first.begin()) {
806 if (position.begin() < pair.second.end()) {
807 return true;
808 }
809 }
810 return false;
811 }
812
GetLabel(const TargetStmtMap & labels,const parser::Label & label)813 LabeledStatementInfoTuplePOD GetLabel(
814 const TargetStmtMap &labels, const parser::Label &label) {
815 const auto iter{labels.find(label)};
816 if (iter == labels.cend()) {
817 return {0u, nullptr, LabeledStmtClassificationSet{}, false};
818 } else {
819 return iter->second;
820 }
821 }
822
823 // 11.1.7.3
CheckBranchesIntoDoBody(const SourceStmtList & branches,const TargetStmtMap & labels,const IndexList & loopBodies,SemanticsContext & context)824 void CheckBranchesIntoDoBody(const SourceStmtList &branches,
825 const TargetStmtMap &labels, const IndexList &loopBodies,
826 SemanticsContext &context) {
827 for (const auto branch : branches) {
828 const auto &label{branch.parserLabel};
829 auto branchTarget{GetLabel(labels, label)};
830 if (HasScope(branchTarget.proxyForScope)) {
831 const auto &fromPosition{branch.parserCharBlock};
832 const auto &toPosition{branchTarget.parserCharBlock};
833 for (const auto body : loopBodies) {
834 if (!InBody(fromPosition, body) && InBody(toPosition, body)) {
835 context.Say(fromPosition, "branch into loop body from outside"_en_US)
836 .Attach(body.first, "the loop branched into"_en_US);
837 }
838 }
839 }
840 }
841 }
842
CheckDoNesting(const IndexList & loopBodies,SemanticsContext & context)843 void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
844 for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
845 const auto &v1{*i1};
846 for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
847 const auto &v2{*i2};
848 if (v2.first.begin() < v1.second.end() &&
849 v1.second.begin() < v2.second.begin()) {
850 context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
851 .Attach(v2.first, "DO loop conflicts"_en_US);
852 }
853 }
854 }
855 }
856
SkipLabel(const parser::CharBlock & position)857 parser::CharBlock SkipLabel(const parser::CharBlock &position) {
858 const std::size_t maxPosition{position.size()};
859 if (maxPosition && parser::IsDecimalDigit(position[0])) {
860 std::size_t i{1l};
861 for (; (i < maxPosition) && parser::IsDecimalDigit(position[i]); ++i) {
862 }
863 for (; (i < maxPosition) && std::isspace(position[i]); ++i) {
864 }
865 return parser::CharBlock{position.begin() + i, position.end()};
866 }
867 return position;
868 }
869
ParentScope(const std::vector<ProxyForScope> & scopes,ProxyForScope scope)870 ProxyForScope ParentScope(
871 const std::vector<ProxyForScope> &scopes, ProxyForScope scope) {
872 return scopes[scope];
873 }
874
CheckLabelDoConstraints(const SourceStmtList & dos,const SourceStmtList & branches,const TargetStmtMap & labels,const std::vector<ProxyForScope> & scopes,SemanticsContext & context)875 void CheckLabelDoConstraints(const SourceStmtList &dos,
876 const SourceStmtList &branches, const TargetStmtMap &labels,
877 const std::vector<ProxyForScope> &scopes, SemanticsContext &context) {
878 IndexList loopBodies;
879 for (const auto stmt : dos) {
880 const auto &label{stmt.parserLabel};
881 const auto &scope{stmt.proxyForScope};
882 const auto &position{stmt.parserCharBlock};
883 auto doTarget{GetLabel(labels, label)};
884 if (!HasScope(doTarget.proxyForScope)) {
885 // C1133
886 context.Say(position,
887 parser::MessageFormattedText{
888 "label '%u' cannot be found"_err_en_US, SayLabel(label)});
889 } else if (doTarget.parserCharBlock.begin() < position.begin()) {
890 // R1119
891 context.Say(position,
892 parser::MessageFormattedText{
893 "label '%u' doesn't lexically follow DO stmt"_err_en_US,
894 SayLabel(label)});
895
896 } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
897 doTarget.labeledStmtClassificationSet.test(
898 TargetStatementEnum::CompatibleDo)) ||
899 (doTarget.isExecutableConstructEndStmt &&
900 ParentScope(scopes, doTarget.proxyForScope) == scope)) {
901 if (context.warnOnNonstandardUsage() ||
902 context.ShouldWarn(
903 parser::LanguageFeature::OldLabelDoEndStatements)) {
904 context
905 .Say(position,
906 parser::MessageFormattedText{
907 "A DO loop should terminate with an END DO or CONTINUE"_en_US})
908 .Attach(doTarget.parserCharBlock,
909 "DO loop currently ends at statement:"_en_US);
910 }
911 } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
912 context.Say(position,
913 parser::MessageFormattedText{
914 "label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
915 } else if (!doTarget.labeledStmtClassificationSet.test(
916 TargetStatementEnum::Do)) {
917 context.Say(doTarget.parserCharBlock,
918 parser::MessageFormattedText{
919 "A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
920 } else {
921 loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
922 }
923 }
924
925 CheckBranchesIntoDoBody(branches, labels, loopBodies, context);
926 CheckDoNesting(loopBodies, context);
927 }
928
929 // 6.2.5
CheckScopeConstraints(const SourceStmtList & stmts,const TargetStmtMap & labels,const std::vector<ProxyForScope> & scopes,SemanticsContext & context)930 void CheckScopeConstraints(const SourceStmtList &stmts,
931 const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
932 SemanticsContext &context) {
933 for (const auto stmt : stmts) {
934 const auto &label{stmt.parserLabel};
935 const auto &scope{stmt.proxyForScope};
936 const auto &position{stmt.parserCharBlock};
937 auto target{GetLabel(labels, label)};
938 if (!HasScope(target.proxyForScope)) {
939 context.Say(position,
940 parser::MessageFormattedText{
941 "label '%u' was not found"_err_en_US, SayLabel(label)});
942 } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
943 context.Say(position,
944 parser::MessageFormattedText{
945 "label '%u' is not in scope"_en_US, SayLabel(label)});
946 }
947 }
948 }
949
CheckBranchTargetConstraints(const SourceStmtList & stmts,const TargetStmtMap & labels,SemanticsContext & context)950 void CheckBranchTargetConstraints(const SourceStmtList &stmts,
951 const TargetStmtMap &labels, SemanticsContext &context) {
952 for (const auto stmt : stmts) {
953 const auto &label{stmt.parserLabel};
954 auto branchTarget{GetLabel(labels, label)};
955 if (HasScope(branchTarget.proxyForScope)) {
956 if (!branchTarget.labeledStmtClassificationSet.test(
957 TargetStatementEnum::Branch) &&
958 !branchTarget.labeledStmtClassificationSet.test(
959 TargetStatementEnum::CompatibleBranch)) {
960 context
961 .Say(branchTarget.parserCharBlock,
962 parser::MessageFormattedText{
963 "'%u' not a branch target"_err_en_US, SayLabel(label)})
964 .Attach(stmt.parserCharBlock,
965 parser::MessageFormattedText{
966 "control flow use of '%u'"_en_US, SayLabel(label)});
967 } else if (!branchTarget.labeledStmtClassificationSet.test(
968 TargetStatementEnum::Branch)) {
969 context
970 .Say(branchTarget.parserCharBlock,
971 parser::MessageFormattedText{
972 "'%u' not a branch target"_en_US, SayLabel(label)})
973 .Attach(stmt.parserCharBlock,
974 parser::MessageFormattedText{
975 "control flow use of '%u'"_en_US, SayLabel(label)});
976 }
977 }
978 }
979 }
980
CheckBranchConstraints(const SourceStmtList & branches,const TargetStmtMap & labels,const std::vector<ProxyForScope> & scopes,SemanticsContext & context)981 void CheckBranchConstraints(const SourceStmtList &branches,
982 const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
983 SemanticsContext &context) {
984 CheckScopeConstraints(branches, labels, scopes, context);
985 CheckBranchTargetConstraints(branches, labels, context);
986 }
987
CheckDataXferTargetConstraints(const SourceStmtList & stmts,const TargetStmtMap & labels,SemanticsContext & context)988 void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
989 const TargetStmtMap &labels, SemanticsContext &context) {
990 for (const auto stmt : stmts) {
991 const auto &label{stmt.parserLabel};
992 auto ioTarget{GetLabel(labels, label)};
993 if (HasScope(ioTarget.proxyForScope)) {
994 if (!ioTarget.labeledStmtClassificationSet.test(
995 TargetStatementEnum::Format)) {
996 context
997 .Say(ioTarget.parserCharBlock,
998 parser::MessageFormattedText{
999 "'%u' not a FORMAT"_err_en_US, SayLabel(label)})
1000 .Attach(stmt.parserCharBlock,
1001 parser::MessageFormattedText{
1002 "data transfer use of '%u'"_en_US, SayLabel(label)});
1003 }
1004 }
1005 }
1006 }
1007
CheckDataTransferConstraints(const SourceStmtList & dataTransfers,const TargetStmtMap & labels,const std::vector<ProxyForScope> & scopes,SemanticsContext & context)1008 void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
1009 const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
1010 SemanticsContext &context) {
1011 CheckScopeConstraints(dataTransfers, labels, scopes, context);
1012 CheckDataXferTargetConstraints(dataTransfers, labels, context);
1013 }
1014
CheckConstraints(ParseTreeAnalyzer && parseTreeAnalysis)1015 bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
1016 auto &context{parseTreeAnalysis.ErrorHandler()};
1017 for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
1018 const auto &dos{programUnit.doStmtSources};
1019 const auto &branches{programUnit.otherStmtSources};
1020 const auto &labels{programUnit.targetStmts};
1021 const auto &scopes{programUnit.scopeModel};
1022 CheckLabelDoConstraints(dos, branches, labels, scopes, context);
1023 CheckBranchConstraints(branches, labels, scopes, context);
1024 const auto &dataTransfers{programUnit.formatStmtSources};
1025 CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
1026 }
1027 return !context.AnyFatalError();
1028 }
1029
ValidateLabels(SemanticsContext & context,const parser::Program & program)1030 bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
1031 return CheckConstraints(LabelAnalysis(context, program));
1032 }
1033 }
1034