common::visitors{
[](auto &) {},
// Labels on end-stmt of constructs are accepted by f18 for
- // compatibility purposes, even-though they are technically
- // not in the same scope as the label-do-stmt.
- [&](common::Indirection<IfConstruct> &ifConstruct) {
+ // as an extension.
+ [&](common::Indirection<AssociateConstruct> &associate) {
CanonicalizeIfMatch(block, stack, i,
- std::get<Statement<EndIfStmt>>(ifConstruct.value().t));
+ std::get<Statement<EndAssociateStmt>>(
+ associate.value().t));
+ },
+ [&](common::Indirection<BlockConstruct> &blockConstruct) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndBlockStmt>>(
+ blockConstruct.value().t));
+ },
+ [&](common::Indirection<ChangeTeamConstruct> &changeTeam) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndChangeTeamStmt>>(
+ changeTeam.value().t));
+ },
+ [&](common::Indirection<CriticalConstruct> &critical) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndCriticalStmt>>(critical.value().t));
},
[&](common::Indirection<DoConstruct> &doConstruct) {
CanonicalizeIfMatch(block, stack, i,
std::get<Statement<EndDoStmt>>(doConstruct.value().t));
},
+ [&](common::Indirection<IfConstruct> &ifConstruct) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndIfStmt>>(ifConstruct.value().t));
+ },
[&](common::Indirection<CaseConstruct> &caseConstruct) {
CanonicalizeIfMatch(block, stack, i,
std::get<Statement<EndSelectStmt>>(
CanonicalizeIfMatch(block, stack, i,
std::get<Statement<EndSelectStmt>>(selectType.value().t));
},
+ [&](common::Indirection<ForallConstruct> &forall) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndForallStmt>>(forall.value().t));
+ },
+ [&](common::Indirection<WhereConstruct> &where) {
+ CanonicalizeIfMatch(block, stack, i,
+ std::get<Statement<EndWhereStmt>>(where.value().t));
+ },
[&](Statement<common::Indirection<LabelDoStmt>> &labelDoStmt) {
auto &label{std::get<Label>(labelDoStmt.statement.value().t)};
stack.push_back(LabelInfo{i, label});
ProxyForScope proxyForScope;
parser::CharBlock parserCharBlock;
LabeledStmtClassificationSet labeledStmtClassificationSet;
- bool legacyAcceptedInDirectSubscope;
+ bool isExecutableConstructEndStmt;
};
using TargetStmtMap = std::map<parser::Label, LabeledStatementInfoTuplePOD>;
struct SourceStatementInfoTuplePOD {
if (std::is_same_v<A, common::Indirection<parser::EndDoStmt>> ||
std::is_same_v<A, parser::EndDoStmt>) {
return Legality::always;
+ } else if (std::is_same_v<A, parser::EndForallStmt> ||
+ std::is_same_v<A, parser::EndWhereStmt>) {
+ // Executable construct end statements are also supported as
+ // an extension but they need special care because the associated
+ // construct create there own scope.
+ return Legality::formerly;
} else {
return Legality::never;
}
return nullptr;
}
+using ExecutableConstructEndStmts = std::tuple<parser::EndIfStmt,
+ parser::EndDoStmt, parser::EndSelectStmt, parser::EndChangeTeamStmt,
+ parser::EndBlockStmt, parser::EndCriticalStmt, parser::EndAssociateStmt>;
+
template<typename A>
-static constexpr bool LabelDoTargetAcceptedInDirectSubscopeOn(
- const parser::Statement<A> &statement) {
- return (std::is_same_v<A, parser::EndIfStmt> ||
- std::is_same_v<A, parser::EndDoStmt> ||
- std::is_same_v<A, parser::EndSelectStmt>);
-}
+static constexpr bool IsExecutableConstructEndStmt{
+ common::HasMember<A, ExecutableConstructEndStmts>};
class ParseTreeAnalyzer {
public:
if (statement.label.has_value()) {
auto label{statement.label.value()};
auto targetFlags{ConstructBranchTargetFlags(statement)};
- bool canBeParentLabel{LabelDoTargetAcceptedInDirectSubscopeOn(statement)};
if constexpr (std::is_same_v<A, parser::AssociateStmt> ||
std::is_same_v<A, parser::BlockStmt> ||
std::is_same_v<A, parser::ChangeTeamStmt> ||
std::is_same_v<A, parser::SelectTypeStmt>) {
constexpr bool useParent{true};
AddTargetLabelDefinition(
- useParent, label, targetFlags, canBeParentLabel);
+ useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
} else {
constexpr bool useParent{false};
AddTargetLabelDefinition(
- useParent, label, targetFlags, canBeParentLabel);
+ useParent, label, targetFlags, IsExecutableConstructEndStmt<A>);
}
}
return true;
// 6.2.5., paragraph 2
void AddTargetLabelDefinition(bool useParent, parser::Label label,
LabeledStmtClassificationSet labeledStmtClassificationSet,
- bool legacyAcceptedInDirectSubscope) {
+ bool isExecutableConstructEndStmt) {
CheckLabelInRange(label);
const auto pair{programUnits_.back().targetStmts.emplace(label,
LabeledStatementInfoTuplePOD{
(useParent ? ParentScope() : currentScope_), currentPosition_,
- labeledStmtClassificationSet, legacyAcceptedInDirectSubscope})};
+ labeledStmtClassificationSet, isExecutableConstructEndStmt})};
if (!pair.second) {
errorHandler_.Say(currentPosition_,
parser::MessageFormattedText{
parser::MessageFormattedText{
"label '%u' doesn't lexically follow DO stmt"_err_en_US,
SayLabel(label)});
+
+ } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
+ doTarget.labeledStmtClassificationSet.test(
+ TargetStatementEnum::CompatibleDo)) ||
+ (doTarget.isExecutableConstructEndStmt &&
+ ParentScope(scopes, doTarget.proxyForScope) == scope)) {
+ // Accepted for legacy support
+ errorHandler.Say(doTarget.parserCharBlock,
+ parser::MessageFormattedText{
+ "A DO loop should terminate with an END DO or CONTINUE"_en_US});
} else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
- // C1133
- if (doTarget.legacyAcceptedInDirectSubscope &&
- ParentScope(scopes, doTarget.proxyForScope) == scope) {
- errorHandler.Say(doTarget.parserCharBlock,
- parser::MessageFormattedText{
- "A DO loop should terminate with an END DO or CONTINUE inside its scope"_en_US});
- } else {
- errorHandler.Say(position,
- parser::MessageFormattedText{
- "label '%u' is not in scope"_err_en_US, SayLabel(label)});
- }
+ errorHandler.Say(position,
+ parser::MessageFormattedText{
+ "label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
} else if (!doTarget.labeledStmtClassificationSet.test(
TargetStatementEnum::Do)) {
- if (!doTarget.labeledStmtClassificationSet.test(
- TargetStatementEnum::CompatibleDo)) {
- errorHandler.Say(doTarget.parserCharBlock,
- parser::MessageFormattedText{
- "A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
- } else {
- errorHandler.Say(doTarget.parserCharBlock,
- parser::MessageFormattedText{
- "A DO loop should terminate with an END DO or CONTINUE"_en_US});
- }
+ errorHandler.Say(doTarget.parserCharBlock,
+ parser::MessageFormattedText{
+ "A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
} else {
loopBodies.emplace_back(SkipLabel(position), doTarget.parserCharBlock);
}
! limitations under the License.
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
-! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
-! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
-! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
+module iso_fortran_env
+ type :: team_type
+ end type
+end
+
+subroutine foo0()
do 1 j=1,2
if (.true.) then
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
1 end if
do 2 k=1,2
do i=3,4
print*, i+k
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
2 end do
do 3 l=1,2
- select case (l)
- case default
- print*, "default"
- case (1)
- print*, "start"
-3 end select
- end
+ do 3 m=1,2
+ select case (l)
+ case default
+ print*, "default", m, l
+ case (1)
+ print*, "start"
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+3 end select
+end subroutine
+
+subroutine foo1()
+ real :: a(10, 10), b(10, 10) = 1.0
+ do 4 k=1,2
+ forall (i = 1:10, j = 1:10, b(i, j) /= 0.0)
+ a(i, j) = real (i + j - k)
+ b(i, j) = a(i, j) + b(i, j) * real (i * j)
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end forall
+end subroutine
+
+subroutine foo2()
+ real :: a(10, 10), b(10, 10) = 1.0
+ do 4 k=1,4
+ where (a<k)
+ a = a + b
+ b = a - b
+ elsewhere
+ a = a*2
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end where
+end subroutine
+
+subroutine foo3()
+ real :: a(10, 10), b(10, 10) = 1.0
+ do 4 k=1,4
+ associate (x=>a(k+1, 2*k), y=>b(k, 2*k-1))
+ x = 4*x*x + x*y -2*y
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end associate
+end subroutine
+
+subroutine foo4()
+ real :: a(10, 10), b(10, 10) = 1.0
+ do 4 k=1,4
+ block
+ real b
+ b = a(k, k)
+ a(k, k) = k*b
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end block
+end subroutine
+
+subroutine foo5()
+ real :: a(10, 10), b(10, 10) = 1.0
+ do 4 k=1,4
+ critical
+ b(k+1, k) = a(k, k+1)
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end critical
+end subroutine
+
+subroutine foo6(a)
+ type whatever
+ class(*), allocatable :: x
+ end type
+ type(whatever) :: a(10)
+ do 4 k=1,10
+ select type (ax => a(k)%x)
+ type is (integer)
+ print*, "integer: ", ax
+ class default
+ print*, "not useable"
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end select
+end subroutine
+
+subroutine foo7(a)
+ integer :: a(..)
+ do 4 k=1,10
+ select rank (a)
+ rank (0)
+ a = a+k
+ rank (1)
+ a(k) = a(k)+k
+ rank default
+ print*, "error"
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+4 end select
+end subroutine
+
+subroutine foo8()
+ use :: iso_fortran_env, only : team_type
+ type(team_type) :: odd_even
+ do 1 k=1,10
+ change team (odd_even)
+! CHECK: A DO loop should terminate with an END DO or CONTINUE
+1 end team
+end subroutine
+
+end
projects / platform / upstream / llvm.git / commitdiff