forked from OSchip/llvm-project
[flang] Add non standard feature for labeled do not ending with END DO or CONTINUE
* The warning was already here, this commit only refactors things so that it can be controled with -Mstandard. * Also makes the warning point to the do-stmt and adds a note to the warning pointing to the statements where it ends. Original-commit: flang-compiler/f18@11e1eb6edd Reviewed-on: https://github.com/flang-compiler/f18/pull/552 Tree-same-pre-rewrite: false
This commit is contained in:
parent
8a4b595bf6
commit
16cf494888
|
@ -32,7 +32,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
|
|||
Hollerith, ArithmeticIF, Assign, AssignedGOTO, Pause, OpenMP,
|
||||
CruftAfterAmpersand, ClassicCComments, AdditionalFormats, BigIntLiterals,
|
||||
RealDoControls, EquivalenceNumericWithCharacter, AdditionalIntrinsics,
|
||||
AnonymousParents)
|
||||
AnonymousParents, OldLabelDoEndStatements)
|
||||
|
||||
using LanguageFeatures =
|
||||
common::EnumSet<LanguageFeature, LanguageFeature_enumSize>;
|
||||
|
|
|
@ -13,9 +13,9 @@
|
|||
// limitations under the License.
|
||||
|
||||
#include "resolve-labels.h"
|
||||
#include "semantics.h"
|
||||
#include "../common/enum-set.h"
|
||||
#include "../common/template.h"
|
||||
#include "../parser/message.h"
|
||||
#include "../parser/parse-tree-visitor.h"
|
||||
#include <cctype>
|
||||
#include <cstdarg>
|
||||
|
@ -227,8 +227,7 @@ static constexpr bool IsExecutableConstructEndStmt{
|
|||
class ParseTreeAnalyzer {
|
||||
public:
|
||||
ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default;
|
||||
ParseTreeAnalyzer(parser::Messages &errorHandler)
|
||||
: errorHandler_{errorHandler} {}
|
||||
ParseTreeAnalyzer(SemanticsContext &context) : context_{context} {}
|
||||
|
||||
template<typename A> constexpr bool Pre(const A &) { return true; }
|
||||
template<typename A> constexpr void Post(const A &) {}
|
||||
|
@ -360,14 +359,14 @@ public:
|
|||
const auto &firstStmt{std::get<parser::Statement<FIRST>>(a.t)};
|
||||
if (const parser::CharBlock * firstName{GetStmtName(firstStmt)}) {
|
||||
if (*firstName != *name) {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(*name,
|
||||
parser::MessageFormattedText{
|
||||
"%s name mismatch"_err_en_US, constructTag})
|
||||
.Attach(*firstName, "should be"_en_US);
|
||||
}
|
||||
} else {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(*name,
|
||||
parser::MessageFormattedText{
|
||||
"%s name not allowed"_err_en_US, constructTag})
|
||||
|
@ -405,7 +404,7 @@ public:
|
|||
if (const auto *otherPointer{
|
||||
std::get_if<parser::Name>(&optionalGenericSpec->u)}) {
|
||||
if (namePointer->source != otherPointer->source) {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(currentPosition_,
|
||||
parser::MessageFormattedText{
|
||||
"INTERFACE generic-name (%s) mismatch"_en_US,
|
||||
|
@ -442,11 +441,11 @@ public:
|
|||
std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(
|
||||
mainProgram.t)}) {
|
||||
if (*endName != program->statement.v.source) {
|
||||
errorHandler_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
|
||||
context_.Say(*endName, "END PROGRAM name mismatch"_err_en_US)
|
||||
.Attach(program->statement.v.source, "should be"_en_US);
|
||||
}
|
||||
} else {
|
||||
errorHandler_.Say(*endName,
|
||||
context_.Say(*endName,
|
||||
parser::MessageFormattedText{
|
||||
"END PROGRAM has name without PROGRAM statement"_err_en_US});
|
||||
}
|
||||
|
@ -518,7 +517,7 @@ public:
|
|||
const std::vector<UnitAnalysis> &ProgramUnits() const {
|
||||
return programUnits_;
|
||||
}
|
||||
parser::Messages &ErrorHandler() { return errorHandler_; }
|
||||
SemanticsContext &ErrorHandler() { return context_; }
|
||||
|
||||
private:
|
||||
bool PushSubscope() {
|
||||
|
@ -639,14 +638,14 @@ private:
|
|||
if (const parser::CharBlock * constructName{GetStmtName(constructStmt)}) {
|
||||
if (endName) {
|
||||
if (*constructName != *endName) {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(*endName,
|
||||
parser::MessageFormattedText{
|
||||
"%s construct name mismatch"_err_en_US, constructTag})
|
||||
.Attach(*constructName, "should be"_en_US);
|
||||
}
|
||||
} else {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(endStmt.source,
|
||||
parser::MessageFormattedText{
|
||||
"%s construct name required but missing"_err_en_US,
|
||||
|
@ -654,7 +653,7 @@ private:
|
|||
.Attach(*constructName, "should be"_en_US);
|
||||
}
|
||||
} else if (endName) {
|
||||
errorHandler_
|
||||
context_
|
||||
.Say(*endName,
|
||||
parser::MessageFormattedText{
|
||||
"%s construct name unexpected"_err_en_US, constructTag})
|
||||
|
@ -737,7 +736,7 @@ private:
|
|||
const auto iter{std::find(constructNames_.crbegin(),
|
||||
constructNames_.crend(), constructName.ToString())};
|
||||
if (iter == constructNames_.crend()) {
|
||||
errorHandler_.Say(constructName,
|
||||
context_.Say(constructName,
|
||||
parser::MessageFormattedText{
|
||||
"%s construct-name is not in scope"_err_en_US, stmtString});
|
||||
}
|
||||
|
@ -746,7 +745,7 @@ private:
|
|||
// 6.2.5, paragraph 2
|
||||
void CheckLabelInRange(parser::Label label) {
|
||||
if (label < 1 || label > 99999) {
|
||||
errorHandler_.Say(currentPosition_,
|
||||
context_.Say(currentPosition_,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' is out of range"_err_en_US, SayLabel(label)});
|
||||
}
|
||||
|
@ -762,7 +761,7 @@ private:
|
|||
(useParent ? ParentScope() : currentScope_), currentPosition_,
|
||||
labeledStmtClassificationSet, isExecutableConstructEndStmt})};
|
||||
if (!pair.second) {
|
||||
errorHandler_.Say(currentPosition_,
|
||||
context_.Say(currentPosition_,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' is not distinct"_err_en_US, SayLabel(label)});
|
||||
}
|
||||
|
@ -793,7 +792,7 @@ private:
|
|||
}
|
||||
|
||||
std::vector<UnitAnalysis> programUnits_;
|
||||
parser::Messages &errorHandler_;
|
||||
SemanticsContext &context_;
|
||||
parser::CharBlock currentPosition_{nullptr};
|
||||
ProxyForScope currentScope_;
|
||||
std::vector<std::string> constructNames_;
|
||||
|
@ -810,8 +809,8 @@ bool InInclusiveScope(const std::vector<ProxyForScope> &scopes,
|
|||
}
|
||||
|
||||
ParseTreeAnalyzer LabelAnalysis(
|
||||
parser::Messages &errorHandler, const parser::Program &program) {
|
||||
ParseTreeAnalyzer analysis{errorHandler};
|
||||
SemanticsContext &context, const parser::Program &program) {
|
||||
ParseTreeAnalyzer analysis{context};
|
||||
Walk(program, analysis);
|
||||
return analysis;
|
||||
}
|
||||
|
@ -839,7 +838,7 @@ LabeledStatementInfoTuplePOD GetLabel(
|
|||
// 11.1.7.3
|
||||
void CheckBranchesIntoDoBody(const SourceStmtList &branches,
|
||||
const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
|
||||
const IndexList &loopBodies, parser::Messages &errorHandler) {
|
||||
const IndexList &loopBodies, SemanticsContext &context) {
|
||||
for (const auto branch : branches) {
|
||||
const auto &label{branch.parserLabel};
|
||||
auto branchTarget{GetLabel(labels, label)};
|
||||
|
@ -848,8 +847,7 @@ void CheckBranchesIntoDoBody(const SourceStmtList &branches,
|
|||
const auto &toPosition{branchTarget.parserCharBlock};
|
||||
for (const auto body : loopBodies) {
|
||||
if (!InBody(fromPosition, body) && InBody(toPosition, body)) {
|
||||
errorHandler
|
||||
.Say(fromPosition, "branch into loop body from outside"_en_US)
|
||||
context.Say(fromPosition, "branch into loop body from outside"_en_US)
|
||||
.Attach(body.first, "the loop branched into"_en_US);
|
||||
}
|
||||
}
|
||||
|
@ -857,15 +855,14 @@ void CheckBranchesIntoDoBody(const SourceStmtList &branches,
|
|||
}
|
||||
}
|
||||
|
||||
void CheckDoNesting(
|
||||
const IndexList &loopBodies, parser::Messages &errorHandler) {
|
||||
void CheckDoNesting(const IndexList &loopBodies, SemanticsContext &context) {
|
||||
for (auto i1{loopBodies.cbegin()}; i1 != loopBodies.cend(); ++i1) {
|
||||
const auto &v1{*i1};
|
||||
for (auto i2{i1 + 1}; i2 != loopBodies.cend(); ++i2) {
|
||||
const auto &v2{*i2};
|
||||
if (v2.first.begin() < v1.second.end() &&
|
||||
v1.second.begin() < v2.second.begin()) {
|
||||
errorHandler.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
|
||||
context.Say(v1.first, "DO loop doesn't properly nest"_err_en_US)
|
||||
.Attach(v2.first, "DO loop conflicts"_en_US);
|
||||
}
|
||||
}
|
||||
|
@ -892,7 +889,7 @@ ProxyForScope ParentScope(
|
|||
|
||||
void CheckLabelDoConstraints(const SourceStmtList &dos,
|
||||
const SourceStmtList &branches, const TargetStmtMap &labels,
|
||||
const std::vector<ProxyForScope> &scopes, parser::Messages &errorHandler) {
|
||||
const std::vector<ProxyForScope> &scopes, SemanticsContext &context) {
|
||||
IndexList loopBodies;
|
||||
for (const auto stmt : dos) {
|
||||
const auto &label{stmt.parserLabel};
|
||||
|
@ -901,12 +898,12 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
|
|||
auto doTarget{GetLabel(labels, label)};
|
||||
if (!HasScope(doTarget.proxyForScope)) {
|
||||
// C1133
|
||||
errorHandler.Say(position,
|
||||
context.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' cannot be found"_err_en_US, SayLabel(label)});
|
||||
} else if (doTarget.parserCharBlock.begin() < position.begin()) {
|
||||
// R1119
|
||||
errorHandler.Say(position,
|
||||
context.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' doesn't lexically follow DO stmt"_err_en_US,
|
||||
SayLabel(label)});
|
||||
|
@ -916,17 +913,23 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
|
|||
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});
|
||||
if (context.warnOnNonstandardUsage() ||
|
||||
context.ShouldWarn(
|
||||
parser::LanguageFeature::OldLabelDoEndStatements)) {
|
||||
context
|
||||
.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"A DO loop should terminate with an END DO or CONTINUE"_en_US})
|
||||
.Attach(doTarget.parserCharBlock,
|
||||
"DO loop currently ends at statement:"_en_US);
|
||||
}
|
||||
} else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
|
||||
errorHandler.Say(position,
|
||||
context.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' is not in DO loop scope"_err_en_US, SayLabel(label)});
|
||||
} else if (!doTarget.labeledStmtClassificationSet.test(
|
||||
TargetStatementEnum::Do)) {
|
||||
errorHandler.Say(doTarget.parserCharBlock,
|
||||
context.Say(doTarget.parserCharBlock,
|
||||
parser::MessageFormattedText{
|
||||
"A DO loop should terminate with an END DO or CONTINUE"_err_en_US});
|
||||
} else {
|
||||
|
@ -934,25 +937,25 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
|
|||
}
|
||||
}
|
||||
|
||||
CheckBranchesIntoDoBody(branches, labels, scopes, loopBodies, errorHandler);
|
||||
CheckDoNesting(loopBodies, errorHandler);
|
||||
CheckBranchesIntoDoBody(branches, labels, scopes, loopBodies, context);
|
||||
CheckDoNesting(loopBodies, context);
|
||||
}
|
||||
|
||||
// 6.2.5
|
||||
void CheckScopeConstraints(const SourceStmtList &stmts,
|
||||
const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
|
||||
parser::Messages &errorHandler) {
|
||||
SemanticsContext &context) {
|
||||
for (const auto stmt : stmts) {
|
||||
const auto &label{stmt.parserLabel};
|
||||
const auto &scope{stmt.proxyForScope};
|
||||
const auto &position{stmt.parserCharBlock};
|
||||
auto target{GetLabel(labels, label)};
|
||||
if (!HasScope(target.proxyForScope)) {
|
||||
errorHandler.Say(position,
|
||||
context.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' was not found"_err_en_US, SayLabel(label)});
|
||||
} else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
|
||||
errorHandler.Say(position,
|
||||
context.Say(position,
|
||||
parser::MessageFormattedText{
|
||||
"label '%u' is not in scope"_en_US, SayLabel(label)});
|
||||
}
|
||||
|
@ -960,7 +963,7 @@ void CheckScopeConstraints(const SourceStmtList &stmts,
|
|||
}
|
||||
|
||||
void CheckBranchTargetConstraints(const SourceStmtList &stmts,
|
||||
const TargetStmtMap &labels, parser::Messages &errorHandler) {
|
||||
const TargetStmtMap &labels, SemanticsContext &context) {
|
||||
for (const auto stmt : stmts) {
|
||||
const auto &label{stmt.parserLabel};
|
||||
auto branchTarget{GetLabel(labels, label)};
|
||||
|
@ -969,7 +972,7 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts,
|
|||
TargetStatementEnum::Branch) &&
|
||||
!branchTarget.labeledStmtClassificationSet.test(
|
||||
TargetStatementEnum::CompatibleBranch)) {
|
||||
errorHandler
|
||||
context
|
||||
.Say(branchTarget.parserCharBlock,
|
||||
parser::MessageFormattedText{
|
||||
"'%u' not a branch target"_err_en_US, SayLabel(label)})
|
||||
|
@ -978,7 +981,7 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts,
|
|||
"control flow use of '%u'"_en_US, SayLabel(label)});
|
||||
} else if (!branchTarget.labeledStmtClassificationSet.test(
|
||||
TargetStatementEnum::Branch)) {
|
||||
errorHandler
|
||||
context
|
||||
.Say(branchTarget.parserCharBlock,
|
||||
parser::MessageFormattedText{
|
||||
"'%u' not a branch target"_en_US, SayLabel(label)})
|
||||
|
@ -992,20 +995,20 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts,
|
|||
|
||||
void CheckBranchConstraints(const SourceStmtList &branches,
|
||||
const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
|
||||
parser::Messages &errorHandler) {
|
||||
CheckScopeConstraints(branches, labels, scopes, errorHandler);
|
||||
CheckBranchTargetConstraints(branches, labels, errorHandler);
|
||||
SemanticsContext &context) {
|
||||
CheckScopeConstraints(branches, labels, scopes, context);
|
||||
CheckBranchTargetConstraints(branches, labels, context);
|
||||
}
|
||||
|
||||
void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
|
||||
const TargetStmtMap &labels, parser::Messages &errorHandler) {
|
||||
const TargetStmtMap &labels, SemanticsContext &context) {
|
||||
for (const auto stmt : stmts) {
|
||||
const auto &label{stmt.parserLabel};
|
||||
auto ioTarget{GetLabel(labels, label)};
|
||||
if (HasScope(ioTarget.proxyForScope)) {
|
||||
if (!ioTarget.labeledStmtClassificationSet.test(
|
||||
TargetStatementEnum::Format)) {
|
||||
errorHandler
|
||||
context
|
||||
.Say(ioTarget.parserCharBlock,
|
||||
parser::MessageFormattedText{
|
||||
"'%u' not a FORMAT"_err_en_US, SayLabel(label)})
|
||||
|
@ -1019,28 +1022,27 @@ void CheckDataXferTargetConstraints(const SourceStmtList &stmts,
|
|||
|
||||
void CheckDataTransferConstraints(const SourceStmtList &dataTransfers,
|
||||
const TargetStmtMap &labels, const std::vector<ProxyForScope> &scopes,
|
||||
parser::Messages &errorHandler) {
|
||||
CheckScopeConstraints(dataTransfers, labels, scopes, errorHandler);
|
||||
CheckDataXferTargetConstraints(dataTransfers, labels, errorHandler);
|
||||
SemanticsContext &context) {
|
||||
CheckScopeConstraints(dataTransfers, labels, scopes, context);
|
||||
CheckDataXferTargetConstraints(dataTransfers, labels, context);
|
||||
}
|
||||
|
||||
bool CheckConstraints(ParseTreeAnalyzer &&parseTreeAnalysis) {
|
||||
auto &errorHandler{parseTreeAnalysis.ErrorHandler()};
|
||||
auto &context{parseTreeAnalysis.ErrorHandler()};
|
||||
for (const auto &programUnit : parseTreeAnalysis.ProgramUnits()) {
|
||||
const auto &dos{programUnit.doStmtSources};
|
||||
const auto &branches{programUnit.otherStmtSources};
|
||||
const auto &labels{programUnit.targetStmts};
|
||||
const auto &scopes{programUnit.scopeModel};
|
||||
CheckLabelDoConstraints(dos, branches, labels, scopes, errorHandler);
|
||||
CheckBranchConstraints(branches, labels, scopes, errorHandler);
|
||||
CheckLabelDoConstraints(dos, branches, labels, scopes, context);
|
||||
CheckBranchConstraints(branches, labels, scopes, context);
|
||||
const auto &dataTransfers{programUnit.formatStmtSources};
|
||||
CheckDataTransferConstraints(dataTransfers, labels, scopes, errorHandler);
|
||||
CheckDataTransferConstraints(dataTransfers, labels, scopes, context);
|
||||
}
|
||||
return !errorHandler.AnyFatalError();
|
||||
return !context.AnyFatalError();
|
||||
}
|
||||
|
||||
bool ValidateLabels(
|
||||
parser::Messages &errorHandler, const parser::Program &program) {
|
||||
return CheckConstraints(LabelAnalysis(errorHandler, program));
|
||||
bool ValidateLabels(SemanticsContext &context, const parser::Program &program) {
|
||||
return CheckConstraints(LabelAnalysis(context, program));
|
||||
}
|
||||
}
|
||||
|
|
|
@ -16,16 +16,16 @@
|
|||
#define FORTRAN_SEMANTICS_RESOLVE_LABELS_H_
|
||||
|
||||
namespace Fortran::parser {
|
||||
class Messages;
|
||||
struct Program;
|
||||
}
|
||||
|
||||
namespace Fortran::semantics {
|
||||
class SemanticsContext;
|
||||
|
||||
/// \brief Validate the labels in the program
|
||||
/// \param messages where to emit messages
|
||||
/// \param context semantic context for errors
|
||||
/// \param program the parse tree of the program
|
||||
/// \return true, iff the program's labels pass semantics checks
|
||||
bool ValidateLabels(parser::Messages &messages, const parser::Program &program);
|
||||
bool ValidateLabels(SemanticsContext &context, const parser::Program &program);
|
||||
}
|
||||
#endif // FORTRAN_SEMANTICS_RESOLVE_LABELS_H_
|
||||
|
|
|
@ -169,7 +169,7 @@ Scope &SemanticsContext::FindScope(parser::CharBlock source) {
|
|||
}
|
||||
|
||||
bool Semantics::Perform() {
|
||||
return ValidateLabels(context_.messages(), program_) &&
|
||||
return ValidateLabels(context_, program_) &&
|
||||
parser::CanonicalizeDo(program_) && // force line break
|
||||
PerformStatementSemantics(context_, program_) &&
|
||||
ModFileWriter{context_}.WriteAll();
|
||||
|
|
|
@ -15,10 +15,126 @@
|
|||
! Error test -- DO loop uses obsolete loop termination statement
|
||||
! See R1131 and C1131
|
||||
|
||||
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
|
||||
! RUN: ${F18} -funparse-with-symbols -Mstandard %s 2>&1 | ${FileCheck} %s
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
program endDo
|
||||
do 10 i = 1, 5
|
||||
! CHECK: A DO loop should terminate with an END DO or CONTINUE
|
||||
10 print *, "in loop"
|
||||
end program endDo
|
||||
|
|
|
@ -1,133 +0,0 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
|
||||
|
||||
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
|
||||
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
|
Loading…
Reference in New Issue