Index: flang/lib/Semantics/resolve-labels.cpp =================================================================== --- flang/lib/Semantics/resolve-labels.cpp +++ flang/lib/Semantics/resolve-labels.cpp @@ -28,6 +28,12 @@ // A ProxyForScope is an integral proxy for a Fortran scope. This is required // because the parse tree does not actually have the scopes required. using ProxyForScope = unsigned; +// Minimal scope information +struct ScopeInfo { + ProxyForScope parent{}; + bool isExteriorGotoFatal{false}; + int depth{0}; +}; struct LabeledStatementInfoTuplePOD { ProxyForScope proxyForScope; parser::CharBlock parserCharBlock; @@ -153,14 +159,14 @@ } struct UnitAnalysis { - UnitAnalysis() { scopeModel.push_back(0); } + UnitAnalysis() { scopeModel.emplace_back(); } SourceStmtList doStmtSources; SourceStmtList formatStmtSources; SourceStmtList otherStmtSources; SourceStmtList assignStmtSources; TargetStmtMap targetStmts; - std::vector scopeModel; + std::vector scopeModel; }; // Some parse tree record for statements simply wrap construct names; @@ -532,25 +538,34 @@ SemanticsContext &ErrorHandler() { return context_; } private: - bool PushSubscope() { - programUnits_.back().scopeModel.push_back(currentScope_); - currentScope_ = programUnits_.back().scopeModel.size() - 1; - return true; + ScopeInfo &PushScope() { + auto &model{programUnits_.back().scopeModel}; + int newDepth{model.empty() ? 1 : model[currentScope_].depth + 1}; + ScopeInfo &result{model.emplace_back()}; + result.parent = currentScope_; + result.depth = newDepth; + currentScope_ = model.size() - 1; + return result; } bool InitializeNewScopeContext() { programUnits_.emplace_back(UnitAnalysis{}); currentScope_ = 0u; - return PushSubscope(); + PushScope(); + return true; } - void PopScope() { - currentScope_ = programUnits_.back().scopeModel[currentScope_]; + ScopeInfo &PopScope() { + ScopeInfo &result{programUnits_.back().scopeModel[currentScope_]}; + currentScope_ = result.parent; + return result; } ProxyForScope ParentScope() { - return programUnits_.back().scopeModel[currentScope_]; + return programUnits_.back().scopeModel[currentScope_].parent; } bool SwitchToNewScope() { - PopScope(); - return PushSubscope(); + ScopeInfo &oldScope{PopScope()}; + bool isExteriorGotoFatal{oldScope.isExteriorGotoFatal}; + PushScope().isExteriorGotoFatal = isExteriorGotoFatal; + return true; } template bool PushConstructName(const A &a) { @@ -558,7 +573,13 @@ if (optionalName) { constructNames_.emplace_back(optionalName->ToString()); } - return PushSubscope(); + // Gotos into this construct from outside it are diagnosed, and + // are fatal unless the construct is a DO, IF, or SELECT CASE. + PushScope().isExteriorGotoFatal = + !(std::is_same_v || + std::is_same_v || + std::is_same_v); + return true; } bool PushConstructName(const parser::BlockConstruct &blockConstruct) { const auto &optionalName{ @@ -567,7 +588,8 @@ if (optionalName) { constructNames_.emplace_back(optionalName->ToString()); } - return PushSubscope(); + PushScope().isExteriorGotoFatal = true; + return true; } template void PopConstructNameIfPresent(const A &a) { const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)}; @@ -796,9 +818,9 @@ std::vector constructNames_; }; -bool InInclusiveScope(const std::vector &scopes, - ProxyForScope tail, ProxyForScope head) { - for (; tail != head; tail = scopes[tail]) { +bool InInclusiveScope(const std::vector &scopes, ProxyForScope tail, + ProxyForScope head) { + for (; tail != head; tail = scopes[tail].parent) { if (!HasScope(tail)) { return false; } @@ -881,13 +903,13 @@ } ProxyForScope ParentScope( - const std::vector &scopes, ProxyForScope scope) { - return scopes[scope]; + const std::vector &scopes, ProxyForScope scope) { + return scopes[scope].parent; } void CheckLabelDoConstraints(const SourceStmtList &dos, const SourceStmtList &branches, const TargetStmtMap &labels, - const std::vector &scopes, SemanticsContext &context) { + const std::vector &scopes, SemanticsContext &context) { IndexList loopBodies; for (const auto &stmt : dos) { const auto &label{stmt.parserLabel}; @@ -936,7 +958,7 @@ // 6.2.5 void CheckScopeConstraints(const SourceStmtList &stmts, - const TargetStmtMap &labels, const std::vector &scopes, + const TargetStmtMap &labels, const std::vector &scopes, SemanticsContext &context) { for (const auto &stmt : stmts) { const auto &label{stmt.parserLabel}; @@ -955,8 +977,22 @@ TargetStatementEnum::Format)) { continue; } + bool isFatal{false}; + ProxyForScope fromScope{scope}; + for (ProxyForScope toScope{target.proxyForScope}; fromScope != toScope; + toScope = scopes[toScope].parent) { + if (scopes[toScope].isExteriorGotoFatal) { + isFatal = true; + break; + } + if (scopes[toScope].depth == scopes[fromScope].depth) { + fromScope = scopes[fromScope].parent; + } + } context.Say(position, - "Label '%u' is in a construct that prevents its use as a branch target here"_en_US, + isFatal + ? "Label '%u' is in a construct that prevents its use as a branch target here"_err_en_US + : "Label '%u' is in a construct that prevents its use as a branch target here"_en_US, SayLabel(label)); } } @@ -990,7 +1026,7 @@ } void CheckBranchConstraints(const SourceStmtList &branches, - const TargetStmtMap &labels, const std::vector &scopes, + const TargetStmtMap &labels, const std::vector &scopes, SemanticsContext &context) { CheckScopeConstraints(branches, labels, scopes, context); CheckBranchTargetConstraints(branches, labels, context); @@ -1015,7 +1051,7 @@ } void CheckDataTransferConstraints(const SourceStmtList &dataTransfers, - const TargetStmtMap &labels, const std::vector &scopes, + const TargetStmtMap &labels, const std::vector &scopes, SemanticsContext &context) { CheckScopeConstraints(dataTransfers, labels, scopes, context); CheckDataXferTargetConstraints(dataTransfers, labels, context); @@ -1045,7 +1081,7 @@ } void CheckAssignConstraints(const SourceStmtList &assigns, - const TargetStmtMap &labels, const std::vector &scopes, + const TargetStmtMap &labels, const std::vector &scopes, SemanticsContext &context) { CheckScopeConstraints(assigns, labels, scopes, context); CheckAssignTargetConstraints(assigns, labels, context); Index: flang/test/Semantics/label05.f90 =================================================================== --- flang/test/Semantics/label05.f90 +++ flang/test/Semantics/label05.f90 @@ -1,12 +1,13 @@ ! RUN: not %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s ! CHECK: Label '50' was not found +! CHECK-NOT: error: Label '55' is in a construct that prevents its use as a branch target here ! CHECK: Label '55' is in a construct that prevents its use as a branch target here ! CHECK: Label '70' is not a branch target ! CHECK: Control flow use of '70' -! CHECK: Label '80' is in a construct that prevents its use as a branch target here -! CHECK: Label '90' is in a construct that prevents its use as a branch target here -! CHECK: Label '91' is in a construct that prevents its use as a branch target here -! CHECK: Label '92' is in a construct that prevents its use as a branch target here +! CHECK: error: Label '80' is in a construct that prevents its use as a branch target here +! CHECK: error: Label '90' is in a construct that prevents its use as a branch target here +! CHECK: error: Label '91' is in a construct that prevents its use as a branch target here +! CHECK: error: Label '92' is in a construct that prevents its use as a branch target here subroutine sub00(a,b,n,m) real a(n,m) Index: flang/test/Semantics/label14.f90 =================================================================== --- flang/test/Semantics/label14.f90 +++ flang/test/Semantics/label14.f90 @@ -1,8 +1,8 @@ ! Tests implemented for this standard -! 11.1.4 - 4 It is permissible to branch to and end-block-stmt only withinh its +! 11.1.4 - 4 It is permissible to branch to an end-block-stmt only within its ! Block Construct -! RUN: %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s +! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s ! CHECK: Label '20' is in a construct that prevents its use as a branch target here subroutine s1