forked from OSchip/llvm-project
[flang] Semantic checks to see if a DO variable is modified
I added infrastructure to SemanticsContext to track active DO variables and the source locations where they appear in DO statements. I also added code to semantics.[h,cc] to check to see if a DO variable is already defined, and, if so, to emit an error message along with a reference to the relevant DO construct. I also added calls to several places where variables are defined to determine if the definitions are happening in the context of an active DO construct. I have not yet added the checks for DO variables being redefined when passing them as actual arguments to dummy arguments with INTENT(OUT) or INTENT(INOUT). I wanted to get these changes merged first and catch up with the other changes in master. Original-commit: flang-compiler/f18@1bbfcca61b Reviewed-on: https://github.com/flang-compiler/f18/pull/860
This commit is contained in:
Pete Steinfeld
parent
17fdc5cc63
commit
611db270f6
|
|
@ -531,6 +531,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
|
|||
"Allocatable object declared here with rank %d"_en_US, rank_);
|
||||
return false;
|
||||
}
|
||||
context.CheckDoVarRedefine(name_);
|
||||
return RunCoarrayRelatedChecks(context);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -29,6 +29,8 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
|
|||
} else if (!IsAllocatableOrPointer(*symbol)) { // C932
|
||||
context_.Say(name.source,
|
||||
"name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
|
||||
} else {
|
||||
context_.CheckDoVarRedefine(name);
|
||||
}
|
||||
},
|
||||
[&](const parser::StructureComponent &structureComponent) {
|
||||
|
|
|
|||
|
|
@ -24,6 +24,27 @@ namespace Fortran::semantics {
|
|||
|
||||
using namespace parser::literals;
|
||||
|
||||
using Bounds = parser::LoopControl::Bounds;
|
||||
|
||||
static const std::list<parser::ConcurrentControl> &GetControls(
|
||||
const parser::LoopControl &loopControl) {
|
||||
const auto &concurrent{
|
||||
std::get<parser::LoopControl::Concurrent>(loopControl.u)};
|
||||
const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
|
||||
return std::get<std::list<parser::ConcurrentControl>>(header.t);
|
||||
}
|
||||
|
||||
static const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {
|
||||
auto &loopControl{doConstruct.GetLoopControl().value()};
|
||||
return std::get<Bounds>(loopControl.u);
|
||||
}
|
||||
|
||||
static const parser::Name &GetDoVariable(
|
||||
const parser::DoConstruct &doConstruct) {
|
||||
const Bounds &bounds{GetBounds(doConstruct)};
|
||||
return bounds.name.thing;
|
||||
}
|
||||
|
||||
// Return the (possibly null) name of the construct
|
||||
template<typename A>
|
||||
static const parser::Name *MaybeGetConstructName(const A &a) {
|
||||
|
|
@ -428,6 +449,38 @@ class DoContext {
|
|||
public:
|
||||
DoContext(SemanticsContext &context) : context_{context} {}
|
||||
|
||||
// Mark this DO construct as a point of definition for the DO variables
|
||||
// or index-names it contains. If they're already defined, emit an error
|
||||
// message. We need to remember both the variable and the source location of
|
||||
// the variable in the DO construct so that we can remove it when we leave
|
||||
// the DO construct and use its location in error messages.
|
||||
void DefineDoVariables(const parser::DoConstruct &doConstruct) {
|
||||
if (doConstruct.IsDoNormal()) {
|
||||
context_.ActivateDoVariable(GetDoVariable(doConstruct));
|
||||
} else if (doConstruct.IsDoConcurrent()) {
|
||||
if (const auto &loopControl{doConstruct.GetLoopControl()}) {
|
||||
const auto &controls{GetControls(*loopControl)};
|
||||
for (const parser::ConcurrentControl &control : controls) {
|
||||
context_.ActivateDoVariable(std::get<parser::Name>(control.t));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Called at the end of a DO construct to deactivate the DO construct
|
||||
void ResetDoVariables(const parser::DoConstruct &doConstruct) {
|
||||
if (doConstruct.IsDoNormal()) {
|
||||
context_.DeactivateDoVariable(GetDoVariable(doConstruct));
|
||||
} else if (doConstruct.IsDoConcurrent()) {
|
||||
if (const auto &loopControl{doConstruct.GetLoopControl()}) {
|
||||
const auto &controls{GetControls(*loopControl)};
|
||||
for (const parser::ConcurrentControl &control : controls) {
|
||||
context_.DeactivateDoVariable(std::get<parser::Name>(control.t));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void Check(const parser::DoConstruct &doConstruct) {
|
||||
if (doConstruct.IsDoConcurrent()) {
|
||||
CheckDoConcurrent(doConstruct);
|
||||
|
|
@ -441,13 +494,6 @@ public:
|
|||
}
|
||||
|
||||
private:
|
||||
using Bounds = parser::LoopControl::Bounds;
|
||||
|
||||
const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {
|
||||
auto &loopControl{doConstruct.GetLoopControl().value()};
|
||||
return std::get<Bounds>(loopControl.u);
|
||||
}
|
||||
|
||||
void SayBadDoControl(parser::CharBlock sourceLocation) {
|
||||
context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
|
||||
}
|
||||
|
|
@ -720,10 +766,15 @@ private:
|
|||
parser::CharBlock currentStatementSourcePosition_;
|
||||
}; // class DoContext
|
||||
|
||||
// DO loops must be canonicalized prior to calling
|
||||
void DoChecker::Leave(const parser::DoConstruct &x) {
|
||||
void DoChecker::Enter(const parser::DoConstruct &doConstruct) {
|
||||
DoContext doContext{context_};
|
||||
doContext.Check(x);
|
||||
doContext.DefineDoVariables(doConstruct);
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::DoConstruct &doConstruct) {
|
||||
DoContext doContext{context_};
|
||||
doContext.Check(doConstruct);
|
||||
doContext.ResetDoVariables(doConstruct);
|
||||
}
|
||||
|
||||
// Return the (possibly null) name of the ConstructNode
|
||||
|
|
@ -846,4 +897,42 @@ void DoChecker::Enter(const parser::ExitStmt &exitStmt) {
|
|||
CheckNesting(StmtType::EXIT, common::GetPtrFromOptional(exitStmt.v));
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::AssignmentStmt &stmt) {
|
||||
const auto &variable{std::get<parser::Variable>(stmt.t)};
|
||||
context_.CheckDoVarRedefine(variable);
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::ConnectSpec &connectSpec) {
|
||||
const auto *newunit{
|
||||
std::get_if<parser::ConnectSpec::Newunit>(&connectSpec.u)};
|
||||
if (newunit) {
|
||||
context_.CheckDoVarRedefine(newunit->v.thing.thing);
|
||||
}
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::InquireSpec &inquireSpec) {
|
||||
const auto *intVar{std::get_if<parser::InquireSpec::IntVar>(&inquireSpec.u)};
|
||||
if (intVar) {
|
||||
const auto &scalar{std::get<parser::ScalarIntVariable>(intVar->t)};
|
||||
context_.CheckDoVarRedefine(scalar.thing.thing);
|
||||
}
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::IoControlSpec &ioControlSpec) {
|
||||
const auto *size{std::get_if<parser::IoControlSpec::Size>(&ioControlSpec.u)};
|
||||
if (size) {
|
||||
context_.CheckDoVarRedefine(size->v.thing.thing);
|
||||
}
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::OutputImpliedDo &outputImpliedDo) {
|
||||
const auto &control{std::get<parser::IoImpliedDoControl>(outputImpliedDo.t)};
|
||||
const parser::Name &name{control.name.thing.thing};
|
||||
context_.CheckDoVarRedefine(*name.symbol, name.source);
|
||||
}
|
||||
|
||||
void DoChecker::Leave(const parser::StatVariable &statVariable) {
|
||||
context_.CheckDoVarRedefine(statVariable.v.thing.thing);
|
||||
}
|
||||
|
||||
} // namespace Fortran::semantics
|
||||
|
|
|
|||
|
|
@ -13,9 +13,15 @@
|
|||
#include "../common/idioms.h"
|
||||
|
||||
namespace Fortran::parser {
|
||||
struct DoConstruct;
|
||||
struct AssignmentStmt;
|
||||
struct ConnectSpec;
|
||||
struct CycleStmt;
|
||||
struct DoConstruct;
|
||||
struct ExitStmt;
|
||||
struct InquireSpec;
|
||||
struct IoControlSpec;
|
||||
struct OutputImpliedDo;
|
||||
struct StatVariable;
|
||||
}
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
|
@ -26,9 +32,16 @@ ENUM_CLASS(StmtType, CYCLE, EXIT)
|
|||
class DoChecker : public virtual BaseChecker {
|
||||
public:
|
||||
explicit DoChecker(SemanticsContext &context) : context_{context} {}
|
||||
void Leave(const parser::DoConstruct &);
|
||||
void Leave(const parser::AssignmentStmt &);
|
||||
void Leave(const parser::ConnectSpec &);
|
||||
void Enter(const parser::CycleStmt &);
|
||||
void Enter(const parser::DoConstruct &);
|
||||
void Leave(const parser::DoConstruct &);
|
||||
void Enter(const parser::ExitStmt &);
|
||||
void Leave(const parser::InquireSpec &);
|
||||
void Leave(const parser::IoControlSpec &);
|
||||
void Leave(const parser::OutputImpliedDo &);
|
||||
void Leave(const parser::StatVariable &);
|
||||
|
||||
private:
|
||||
SemanticsContext &context_;
|
||||
|
|
|
|||
|
|
@ -505,10 +505,43 @@ void IoChecker::Leave(const parser::PrintStmt &) {
|
|||
Done();
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::ReadStmt &) {
|
||||
static void CheckForDoVariableInNamelist(const Symbol &namelist,
|
||||
SemanticsContext &context, parser::CharBlock namelistLocation) {
|
||||
const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
|
||||
for (const Symbol &object : details.objects()) {
|
||||
context.CheckDoVarRedefine(object, namelistLocation);
|
||||
}
|
||||
}
|
||||
|
||||
static void CheckForDoVariableInNamelistSpec(
|
||||
const parser::ReadStmt &readStmt, SemanticsContext &context) {
|
||||
const std::list<parser::IoControlSpec> &controls{readStmt.controls};
|
||||
for (const auto &control : controls) {
|
||||
if (const auto *namelist{std::get_if<parser::Name>(&control.u)}) {
|
||||
if (const Symbol * symbol{namelist->symbol}) {
|
||||
CheckForDoVariableInNamelist(*symbol, context, namelist->source);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void CheckForDoVariable(
|
||||
const parser::ReadStmt &readStmt, SemanticsContext &context) {
|
||||
CheckForDoVariableInNamelistSpec(readStmt, context);
|
||||
const std::list<parser::InputItem> &items{readStmt.items};
|
||||
for (const auto &item : items) {
|
||||
if (const parser::Variable *
|
||||
variable{std::get_if<parser::Variable>(&item.u)}) {
|
||||
context.CheckDoVarRedefine(*variable);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::ReadStmt &readStmt) {
|
||||
if (!flags_.test(Flag::InternalUnit)) {
|
||||
CheckForPureSubprogram();
|
||||
}
|
||||
CheckForDoVariable(readStmt, context_);
|
||||
if (!flags_.test(Flag::IoControlList)) {
|
||||
Done();
|
||||
return;
|
||||
|
|
|
|||
|
|
@ -32,6 +32,7 @@
|
|||
#include "symbol.h"
|
||||
#include "../common/default-kinds.h"
|
||||
#include "../parser/parse-tree-visitor.h"
|
||||
#include "../parser/tools.h"
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
|
|
@ -202,6 +203,71 @@ void SemanticsContext::PopConstruct() {
|
|||
constructStack_.pop_back();
|
||||
}
|
||||
|
||||
void SemanticsContext::SayDoVarRedefine(
|
||||
const parser::CharBlock &location, const Symbol &variable) {
|
||||
const parser::CharBlock doLoc{GetDoVariableLocation(variable)};
|
||||
CHECK(doLoc != parser::CharBlock{});
|
||||
Say(location, "Cannot redefine DO variable '%s'"_err_en_US, variable.name())
|
||||
.Attach(doLoc, "Enclosing DO construct"_en_US);
|
||||
}
|
||||
|
||||
void SemanticsContext::CheckDoVarRedefine(
|
||||
const Symbol &variable, const parser::CharBlock &location) {
|
||||
if (const Symbol * root{GetAssociationRoot(variable)}) {
|
||||
if (IsActiveDoVariable(*root)) {
|
||||
SayDoVarRedefine(location, *root);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void SemanticsContext::CheckDoVarRedefine(const parser::Variable &variable) {
|
||||
if (const Symbol * entity{GetLastName(variable).symbol}) {
|
||||
const parser::CharBlock &sourceLocation{variable.GetSource()};
|
||||
CheckDoVarRedefine(*entity, sourceLocation);
|
||||
}
|
||||
}
|
||||
|
||||
void SemanticsContext::CheckDoVarRedefine(const parser::Name &name) {
|
||||
const parser::CharBlock &sourceLocation{name.source};
|
||||
if (const Symbol * entity{name.symbol}) {
|
||||
CheckDoVarRedefine(*entity, sourceLocation);
|
||||
}
|
||||
}
|
||||
|
||||
void SemanticsContext::ActivateDoVariable(const parser::Name &name) {
|
||||
CheckDoVarRedefine(name);
|
||||
if (const Symbol * doVariable{name.symbol}) {
|
||||
if (const Symbol * root{GetAssociationRoot(*doVariable)}) {
|
||||
if (!IsActiveDoVariable(*root)) {
|
||||
activeDoVariables_.emplace(*root, name.source);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void SemanticsContext::DeactivateDoVariable(const parser::Name &name) {
|
||||
if (Symbol * doVariable{name.symbol}) {
|
||||
if (const Symbol * root{GetAssociationRoot(*doVariable)}) {
|
||||
if (name.source == GetDoVariableLocation(*root)) {
|
||||
activeDoVariables_.erase(*root);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bool SemanticsContext::IsActiveDoVariable(const Symbol &variable) {
|
||||
return activeDoVariables_.find(variable) != activeDoVariables_.end();
|
||||
}
|
||||
|
||||
parser::CharBlock SemanticsContext::GetDoVariableLocation(
|
||||
const Symbol &variable) {
|
||||
if (IsActiveDoVariable(variable)) {
|
||||
return activeDoVariables_[variable];
|
||||
} else {
|
||||
return parser::CharBlock{};
|
||||
}
|
||||
}
|
||||
|
||||
bool Semantics::Perform() {
|
||||
return ValidateLabels(context_, program_) &&
|
||||
parser::CanonicalizeDo(program_) && // force line break
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ struct ForallConstruct;
|
|||
struct IfConstruct;
|
||||
struct SelectRankConstruct;
|
||||
struct SelectTypeConstruct;
|
||||
struct Variable;
|
||||
struct WhereConstruct;
|
||||
}
|
||||
|
||||
|
|
@ -149,7 +150,18 @@ public:
|
|||
}
|
||||
void PopConstruct();
|
||||
|
||||
// Check to see if a variable being redefined is a DO variable. If so, emit
|
||||
// a message
|
||||
void CheckDoVarRedefine(const Symbol &, const parser::CharBlock &);
|
||||
void CheckDoVarRedefine(const parser::Variable &);
|
||||
void CheckDoVarRedefine(const parser::Name &);
|
||||
void ActivateDoVariable(const parser::Name &);
|
||||
void DeactivateDoVariable(const parser::Name &);
|
||||
bool IsActiveDoVariable(const Symbol &);
|
||||
|
||||
private:
|
||||
parser::CharBlock GetDoVariableLocation(const Symbol &);
|
||||
void SayDoVarRedefine(const parser::CharBlock &, const Symbol &);
|
||||
const common::IntrinsicTypeDefaultKinds &defaultKinds_;
|
||||
const common::LanguageFeatureControl languageFeatures_;
|
||||
parser::AllSources &allSources_;
|
||||
|
|
@ -166,6 +178,7 @@ private:
|
|||
|
||||
bool CheckError(bool);
|
||||
ConstructStack constructStack_;
|
||||
std::map<SymbolRef, const parser::CharBlock> activeDoVariables_;
|
||||
};
|
||||
|
||||
class Semantics {
|
||||
|
|
|
|||
|
|
@ -152,6 +152,7 @@ set(ERROR_TESTS
|
|||
dosemantics09.f90
|
||||
dosemantics10.f90
|
||||
dosemantics11.f90
|
||||
dosemantics12.f90
|
||||
expr-errors01.f90
|
||||
expr-errors02.f90
|
||||
null01.f90
|
||||
|
|
|
|||
|
|
@ -0,0 +1,375 @@
|
|||
! 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.
|
||||
!
|
||||
!Section 11.1.7.4.3, paragraph 2 states:
|
||||
! Except for the incrementation of the DO variable that occurs in step (3),
|
||||
! the DO variable shall neither be redefined nor become undefined while the
|
||||
! DO construct is active.
|
||||
|
||||
subroutine s1()
|
||||
|
||||
! Redefinition via intrinsic assignment (section 19.6.5, case (1))
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
ivar = 99
|
||||
end do
|
||||
|
||||
! Redefinition in the presence of a construct association
|
||||
associate (avar => ivar)
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
avar = 99
|
||||
end do
|
||||
end associate
|
||||
|
||||
ivar = 99
|
||||
|
||||
! Redefinition via intrinsic assignment (section 19.6.5, case (1))
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
ivar = 99
|
||||
end do
|
||||
|
||||
ivar = 99
|
||||
|
||||
end subroutine s1
|
||||
|
||||
subroutine s2()
|
||||
|
||||
integer :: ivar
|
||||
|
||||
read '(I10)', ivar
|
||||
|
||||
! Redefinition via an input statement (section 19.6.5, case (3))
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read '(I10)', ivar
|
||||
end do
|
||||
|
||||
! Redefinition via an input statement (section 19.6.5, case (3))
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read '(I10)', ivar
|
||||
end do
|
||||
|
||||
end subroutine s2
|
||||
|
||||
subroutine s3()
|
||||
|
||||
integer :: ivar
|
||||
|
||||
! Redefinition via use as a DO variable (section 19.6.5, case (4))
|
||||
do ivar = 1,10
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
do ivar = 1,20
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
do ivar = 1,30
|
||||
print *, "hello"
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! This one's OK, even though we used ivar previously as a DO variable
|
||||
! since it's not a redefinition
|
||||
do ivar = 1,40
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
! Redefinition via use as a DO variable (section 19.6.5, case (4))
|
||||
do concurrent (ivar = 1:10)
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine s3
|
||||
|
||||
subroutine s4()
|
||||
|
||||
integer :: ivar
|
||||
real :: x(10)
|
||||
|
||||
print '(f10.5)', (x(ivar), ivar = 1, 10)
|
||||
|
||||
! Redefinition via use as a DO variable (section 19.6.5, case (5))
|
||||
do ivar = 1,20
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
print '(f10.5)', (x(ivar), ivar = 1, 10)
|
||||
end do
|
||||
|
||||
! Redefinition via use as a DO variable (section 19.6.5, case (5))
|
||||
do concurrent (ivar = 1:10)
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
print '(f10.5)', (x(ivar), ivar = 1, 10)
|
||||
end do
|
||||
|
||||
end subroutine s4
|
||||
|
||||
subroutine s5()
|
||||
|
||||
integer :: ivar
|
||||
real :: x
|
||||
|
||||
read (3, '(f10.5)', iostat = ivar) x
|
||||
|
||||
! Redefinition via use in IOSTAT specifier (section 19.6.5, case (7))
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read (3, '(f10.5)', iostat = ivar) x
|
||||
end do
|
||||
|
||||
! Redefinition via use in IOSTAT specifier (section 19.6.5, case (7))
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read (3, '(f10.5)', iostat = ivar) x
|
||||
end do
|
||||
|
||||
end subroutine s5
|
||||
|
||||
subroutine s6()
|
||||
|
||||
character (len=3) :: key
|
||||
integer :: chars
|
||||
integer :: ivar
|
||||
real :: x
|
||||
|
||||
read (3, '(a3)', advance='no', size = chars) key
|
||||
|
||||
! Redefinition via use in SIZE specifier (section 19.6.5, case (9))
|
||||
do ivar = 1,20
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read (3, '(a3)', advance='no', size = ivar) key
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
! Redefinition via use in SIZE specifier (section 19.6.5, case (9))
|
||||
do concurrent (ivar = 1:10)
|
||||
!ERROR: ADVANCE specifier is not allowed in DO CONCURRENT
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
read (3, '(a3)', advance='no', size = ivar) key
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
end subroutine s6
|
||||
|
||||
subroutine s7()
|
||||
|
||||
integer :: iostatVar, nextrecVar, numberVar, posVar, reclVar, sizeVar
|
||||
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
|
||||
! Redefinition via use in IOSTAT specifier (section 19.6.5, case (10))
|
||||
do iostatVar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'iostatvar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in IOSTAT specifier (section 19.6.5, case (10))
|
||||
do concurrent (iostatVar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'iostatvar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in NEXTREC specifier (section 19.6.5, case (10))
|
||||
do nextrecVar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'nextrecvar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in NEXTREC specifier (section 19.6.5, case (10))
|
||||
do concurrent (nextrecVar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'nextrecvar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in NUMBER specifier (section 19.6.5, case (10))
|
||||
do numberVar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'numbervar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in NUMBER specifier (section 19.6.5, case (10))
|
||||
do concurrent (numberVar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'numbervar'
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in RECL specifier (section 19.6.5, case (10))
|
||||
do reclVar = 1,20
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'reclvar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in RECL specifier (section 19.6.5, case (10))
|
||||
do concurrent (reclVar = 1:10)
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'reclvar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in POS specifier (section 19.6.5, case (10))
|
||||
do posVar = 1,20
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'posvar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in POS specifier (section 19.6.5, case (10))
|
||||
do concurrent (posVar = 1:10)
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'posvar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in SIZE specifier (section 19.6.5, case (10))
|
||||
do sizeVar = 1,20
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'sizevar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
! Redefinition via use in SIZE specifier (section 19.6.5, case (10))
|
||||
do concurrent (sizeVar = 1:10)
|
||||
print *, "hello"
|
||||
inquire(3, iostat=iostatVar, nextrec=nextrecVar, number=numberVar, &
|
||||
!ERROR: Cannot redefine DO variable 'sizevar'
|
||||
pos=posVar, recl=reclVar, size=sizeVar)
|
||||
end do
|
||||
|
||||
end subroutine s7
|
||||
|
||||
subroutine s8()
|
||||
|
||||
Integer :: ivar
|
||||
integer, pointer :: ip
|
||||
|
||||
allocate(ip, stat = ivar)
|
||||
|
||||
! Redefinition via a STAT= specifier (section 19.6.5, case (16))
|
||||
do ivar = 1,20
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
allocate(ip, stat = ivar)
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
! Redefinition via a STAT= specifier (section 19.6.5, case (16))
|
||||
do concurrent (ivar = 1:10)
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
allocate(ip, stat = ivar)
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
end subroutine s8
|
||||
|
||||
subroutine s9()
|
||||
|
||||
Integer :: ivar
|
||||
|
||||
! OK since the DO CONCURRENT index-name exists only in the scope of the
|
||||
! DO CONCURRENT construct
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
end do
|
||||
end do
|
||||
|
||||
! OK since the DO CONCURRENT index-name exists only in the scope of the
|
||||
! DO CONCURRENT construct
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine s9
|
||||
|
||||
subroutine s10()
|
||||
|
||||
Integer :: ivar
|
||||
open(file="abc", newunit=ivar)
|
||||
|
||||
! Redefinition via NEWUNIT specifier (section 19.6.5, case (29))
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
open(file="abc", newunit=ivar)
|
||||
end do
|
||||
|
||||
! Redefinition via NEWUNIT specifier (section 19.6.5, case (29))
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
open(file="abc", newunit=ivar)
|
||||
end do
|
||||
|
||||
end subroutine s10
|
||||
|
||||
subroutine s11()
|
||||
|
||||
Integer, allocatable :: ivar
|
||||
|
||||
allocate(ivar)
|
||||
|
||||
! This look is OK
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
end do
|
||||
|
||||
! Redefinition via deallocation (section 19.6.6, case (10))
|
||||
do ivar = 1,20
|
||||
print *, "hello"
|
||||
!ERROR: Cannot redefine DO variable 'ivar'
|
||||
deallocate(ivar)
|
||||
end do
|
||||
|
||||
! This case is not applicable since the version of "ivar" that's inside the
|
||||
! DO CONCURRENT has the scope of the DO CONCURRENT construct. Within that
|
||||
! scope, it does not have the "allocatable" attribute, so the following test
|
||||
! fails because you can only deallocate a variable that's allocatable.
|
||||
do concurrent (ivar = 1:10)
|
||||
print *, "hello"
|
||||
!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
|
||||
deallocate(ivar)
|
||||
end do
|
||||
|
||||
end subroutine s11
|
||||
Loading…
Reference in New Issue