maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] # This is a combination of 2 commits. 

# This is the 1st commit message:

Changes to disallow image control statements in DO CONCURRENT

Most of these changes were already implemented.  The last remaining part was to check for calls to move_alloc with coarray arguments.  This set of changes implements that.  I also bundled other changes.  Specifically:

All of the code to detect image control statements was moved from check-do.cc to tools.cc so that it could be used by other semantic checking functions.

I added location information to the error messages for all DO semantics checks to highlight either the DO loop associated with the error or other relevant source locations.

I cleaned up the error messages associated with DO semantics so that they have more consistent grammar and punctuation.

I eliminated redundant checks for IEEE_GET_FLAG and IEEE_HALTING_MODE.

I removed the redundant test doconcurrent08.f90.

Responses to pull request comments

I changed the interface to determine whether a statement is an image control
statement to use an ExecutableConstruct as its input.  Since
ExecutableConstruct contains types that do not have source location information
(ChangeTeamConstruct and CriticalConstruct), I also created a function to get
the source location of an ExecutableConstruct.  Also, some ExecutableConstructs
are image control statements because they reference coarrays.  I wanted to tell
users that the reason that an ALLOCATE statement (for example) is an image
control statement because it references a coarray.  To make this happen, I
added another function to return a message for image control statements that
reference coarrays.

I also cleaned up the references to the standard in comments in check-do.cc to
briefly describe the contents of those constraints.

I also added messages that refer to the enclosing DO CONCURRENT statement for
error messages where appropriate.

Responses to pull request comments

The biggest change was to redo the implementation of "IsImageControlStmt()" to
use a custom visitor that strips off the "common::Indirection<...>" prefix of
most of the image control statement types and also takes advantage of
"common::HasMember<...>" to determine if a variant contains a specific type.

Spelling error.

# This is the commit message flang-compiler/f18#2:

More refactoring in response to comments on the pull request.

Original-commit: flang-compiler/f18@3f0a0155b3
Reviewed-on: https://github.com/flang-compiler/f18/pull/780
This commit is contained in:
Pete Steinfeld 2019-10-11 14:39:33 -07:00
parent f0cef274b9
commit 196fec7d85
10 changed files with 311 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

223
flang/lib/semantics/check-do.cc
View File

@ -36,6 +36,10 @@ static const parser::Name *MaybeGetConstructName(const A &a) {
return common::GetPtrFromOptional(std::get<0>(std::get<0>(a.t).statement.t));
}
static parser::MessageFixedText GetEnclosingDoMsg() {
return "Enclosing DO CONCURRENT statement"_en_US;
}
static const parser::Name *MaybeGetConstructName(
const parser::BlockConstruct &blockConstruct) {
return common::GetPtrFromOptional(
@ -43,19 +47,38 @@ static const parser::Name *MaybeGetConstructName(
.statement.v);
}
// Return the (possibly null) name of the statement
template<typename A> static const parser::Name *MaybeGetStmtName(const A &a) {
return common::GetPtrFromOptional(std::get<0>(a.t));
static void SayWithDo(SemanticsContext &context, parser::CharBlock stmtLocation,
parser::MessageFixedText &&message, parser::CharBlock doLocation) {
context.Say(stmtLocation, message).Attach(doLocation, GetEnclosingDoMsg());
}
// 11.1.7.5 - enforce semantics constraints on a DO CONCURRENT loop body
class DoConcurrentBodyEnforce {
public:
DoConcurrentBodyEnforce(SemanticsContext &context) : context_{context} {}
DoConcurrentBodyEnforce(
SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)
: context_{context}, doConcurrentSourcePosition_{
doConcurrentSourcePosition} {}
std::set<parser::Label> labels() { return labels_; }
std::set<SourceName> names() { return names_; }
template<typename T> bool Pre(const T &) { return true; }
template<typename T> void Post(const T &) {}
// C1137 -- No image control statements in a DO CONCURRENT
void Post(const parser::ExecutableConstruct &construct) {
if (IsImageControlStmt(construct)) {
const parser::CharBlock statementLocation{
GetImageControlStmtLocation(construct)};
auto &msg{context_.Say(statementLocation,
"An image control statement is not allowed in DO"
" CONCURRENT"_err_en_US)};
if (auto coarrayMsg{GetImageControlStmtCoarrayMsg(construct)}) {
msg.Attach(statementLocation, *coarrayMsg);
}
msg.Attach(doConcurrentSourcePosition_, GetEnclosingDoMsg());
}
}
template<typename T> bool Pre(const parser::Statement<T> &statement) {
currentStatementSourcePosition_ = statement.source;
if (statement.label.has_value()) {
@ -64,7 +87,7 @@ public:
return true;
}
// C1167
// C1167 -- EXIT statements can't exit a DO CONCURRENT
bool Pre(const parser::WhereConstruct &s) {
AddName(MaybeGetConstructName(s));
return true;
@ -115,140 +138,68 @@ public:
return true;
}
// C1136
// C1136 -- No RETURN statements in a DO CONCURRENT
void Post(const parser::ReturnStmt &) {
context_.Say(currentStatementSourcePosition_,
"RETURN not allowed in DO CONCURRENT"_err_en_US);
}
// C1137
void NoImageControl() {
context_.Say(currentStatementSourcePosition_,
"image control statement not allowed in DO CONCURRENT"_err_en_US);
}
// more C1137 checks
void Post(const parser::SyncAllStmt &) { NoImageControl(); }
void Post(const parser::SyncImagesStmt &) { NoImageControl(); }
void Post(const parser::SyncMemoryStmt &) { NoImageControl(); }
void Post(const parser::SyncTeamStmt &) { NoImageControl(); }
void Post(const parser::ChangeTeamConstruct &) { NoImageControl(); }
void Post(const parser::CriticalConstruct &) { NoImageControl(); }
void Post(const parser::EventPostStmt &) { NoImageControl(); }
void Post(const parser::EventWaitStmt &) { NoImageControl(); }
void Post(const parser::FormTeamStmt &) { NoImageControl(); }
void Post(const parser::LockStmt &) { NoImageControl(); }
void Post(const parser::UnlockStmt &) { NoImageControl(); }
void Post(const parser::StopStmt &) { NoImageControl(); }
// more C1137 checks
void Post(const parser::AllocateStmt &allocateStmt) {
CheckDoesntContainCoarray(allocateStmt);
}
void Post(const parser::DeallocateStmt &deallocateStmt) {
CheckDoesntContainCoarray(deallocateStmt); // C1137
// C1140: deallocation of polymorphic objects
if (anyObjectIsPolymorphic()) {
context_.Say(currentStatementSourcePosition_,
"DEALLOCATE polymorphic object(s) not allowed"
" in DO CONCURRENT"_err_en_US);
}
}
template<typename T> void Post(const parser::Statement<T> &) {
if (EndTDeallocatesCoarray()) {
context_.Say(currentStatementSourcePosition_,
"implicit deallocation of coarray not allowed"
" in DO CONCURRENT"_err_en_US);
}
context_
.Say(currentStatementSourcePosition_,
"RETURN is not allowed in DO CONCURRENT"_err_en_US)
.Attach(doConcurrentSourcePosition_, GetEnclosingDoMsg());
}
// C1139: call to impure procedure and ...
// C1141: cannot call ieee_get_flag, ieee_[gs]et_halting_mode
// It's not necessary to check the ieee_get* procedures because they're
// not pure, and impure procedures are caught by checks for constraint C1139
void Post(const parser::ProcedureDesignator &procedureDesignator) {
if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
// C1137: call move_alloc with coarray arguments
if (name->source == "move_alloc") {
if (anyObjectIsCoarray()) {
context_.Say(currentStatementSourcePosition_,
"call to MOVE_ALLOC intrinsic in DO CONCURRENT with coarray"
" argument(s) not allowed"_err_en_US);
}
}
// C1139: call to impure procedure
if (name->symbol && !IsPureProcedure(*name->symbol)) {
context_.Say(currentStatementSourcePosition_,
"call to impure procedure in DO CONCURRENT not allowed"_err_en_US);
SayWithDo(context_, currentStatementSourcePosition_,
"Call to an impure procedure is not allowed in DO"
" CONCURRENT"_err_en_US,
doConcurrentSourcePosition_);
}
if (name->symbol && fromScope(*name->symbol, "ieee_exceptions"s)) {
if (name->source == "ieee_get_flag") {
context_.Say(currentStatementSourcePosition_,
"IEEE_GET_FLAG not allowed in DO CONCURRENT"_err_en_US);
} else if (name->source == "ieee_set_halting_mode") {
context_.Say(currentStatementSourcePosition_,
"IEEE_SET_HALTING_MODE not allowed in DO CONCURRENT"_err_en_US);
} else if (name->source == "ieee_get_halting_mode") {
context_.Say(currentStatementSourcePosition_,
"IEEE_GET_HALTING_MODE not allowed in DO CONCURRENT"_err_en_US);
if (name->source == "ieee_set_halting_mode") {
SayWithDo(context_, currentStatementSourcePosition_,
"IEEE_SET_HALTING_MODE is not allowed in DO "
"CONCURRENT"_err_en_US,
doConcurrentSourcePosition_);
}
}
} else {
// C1139: this a procedure component
// C1139: check for an impure procedure component
auto &component{std::get<parser::ProcComponentRef>(procedureDesignator.u)
.v.thing.component};
if (component.symbol && !IsPureProcedure(*component.symbol)) {
context_.Say(currentStatementSourcePosition_,
"call to impure procedure in DO CONCURRENT not allowed"_err_en_US);
SayWithDo(context_, currentStatementSourcePosition_,
"Call to an impure procedure component is not allowed"
" in DO CONCURRENT"_err_en_US,
doConcurrentSourcePosition_);
}
}
}
// 11.1.7.5
// 11.1.7.5, paragraph 5, no ADVANCE specifier in a DO CONCURRENT
void Post(const parser::IoControlSpec &ioControlSpec) {
if (auto *charExpr{
std::get_if<parser::IoControlSpec::CharExpr>(&ioControlSpec.u)}) {
if (std::get<parser::IoControlSpec::CharExpr::Kind>(charExpr->t) ==
parser::IoControlSpec::CharExpr::Kind::Advance) {
context_.Say(currentStatementSourcePosition_,
"ADVANCE specifier not allowed in DO CONCURRENT"_err_en_US);
SayWithDo(context_, currentStatementSourcePosition_,
"ADVANCE specifier is not allowed in DO"
" CONCURRENT"_err_en_US,
doConcurrentSourcePosition_);
}
}
}
private:
// C1137 helper functions
void CheckAllocateObjectIsntCoarray(
const parser::AllocateObject &allocateObject, StmtType stmtType) {
const parser::Name &name{GetLastName(allocateObject)};
if (name.symbol && IsCoarray(*name.symbol)) {
context_.Say(name.source,
"%s coarray not allowed in DO CONCURRENT"_err_en_US,
EnumToString(stmtType));
}
// Return the (possibly null) name of the statement
template<typename A> static const parser::Name *MaybeGetStmtName(const A &a) {
return common::GetPtrFromOptional(std::get<0>(a.t));
}
void CheckDoesntContainCoarray(const parser::AllocateStmt &allocateStmt) {
const auto &allocationList{
std::get<std::list<parser::Allocation>>(allocateStmt.t)};
for (const auto &allocation : allocationList) {
const auto &allocateObject{
std::get<parser::AllocateObject>(allocation.t)};
CheckAllocateObjectIsntCoarray(allocateObject, StmtType::ALLOCATE);
}
}
void CheckDoesntContainCoarray(const parser::DeallocateStmt &deallocateStmt) {
const auto &allocateObjectList{
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)};
for (const auto &allocateObject : allocateObjectList) {
CheckAllocateObjectIsntCoarray(allocateObject, StmtType::DEALLOCATE);
}
}
bool anyObjectIsCoarray() { return false; } // FIXME placeholder
bool anyObjectIsPolymorphic() { return false; } // FIXME placeholder
bool EndTDeallocatesCoarray() { return false; } // FIXME placeholder
bool fromScope(const Symbol &symbol, const std::string &moduleName) {
if (symbol.GetUltimate().owner().IsModule() &&
symbol.GetUltimate().owner().GetName().value().ToString() ==
@ -268,6 +219,7 @@ private:
std::set<parser::Label> labels_;
parser::CharBlock currentStatementSourcePosition_;
SemanticsContext &context_;
parser::CharBlock doConcurrentSourcePosition_;
}; // class DoConcurrentBodyEnforce
class DoConcurrentLabelEnforce {
@ -318,8 +270,9 @@ public:
void checkLabelUse(const parser::Label &labelUsed) {
if (labels_.find(labelUsed) == labels_.end()) {
context_.Say(currentStatementSourcePosition_,
"control flow escapes from DO CONCURRENT"_err_en_US);
SayWithDo(context_, currentStatementSourcePosition_,
"Control flow escapes from DO CONCURRENT"_err_en_US,
doConcurrentSourcePosition_);
}
}
@ -331,7 +284,8 @@ private:
parser::CharBlock doConcurrentSourcePosition_{nullptr};
}; // class DoConcurrentLabelEnforce
// Class for enforcing C1130
// Class for enforcing C1130 -- in a DO CONCURRENT with DEFAULT(NONE),
// variables from enclosing scopes must have their locality specified
class DoConcurrentVariableEnforce {
public:
DoConcurrentVariableEnforce(
@ -349,11 +303,14 @@ public:
if (IsVariableName(*symbol)) {
const Scope &variableScope{symbol->owner()};
if (DoesScopeContain(&variableScope, blockScope_)) {
context_.Say(name.source,
"Variable '%s' from an enclosing scope referenced in a DO "
"CONCURRENT with DEFAULT(NONE) must appear in a "
"locality-spec"_err_en_US,
name.source);
context_
.Say(name.source,
"Variable '%s' from an enclosing scope referenced in a DO "
"CONCURRENT with DEFAULT(NONE) must appear in a "
"locality-spec"_err_en_US,
name.source)
.Attach(symbol->name(), "Declaration of variable '%s'"_en_US,
symbol->name());
}
}
}
@ -439,8 +396,8 @@ private:
}
void CheckDoNormal(const parser::DoConstruct &doConstruct) {
// C1120 extended by allowing REAL and DOUBLE PRECISION
// Get the bounds, then check the variable, init, final, and step
// C1120 -- types of DO variables must be INTEGER, extended by allowing
// REAL and DOUBLE PRECISION
const Bounds &bounds{GetBounds(doConstruct)};
CheckDoVariable(bounds.name);
CheckDoExpression(bounds.lower);
@ -456,7 +413,7 @@ private:
currentStatementSourcePosition_ = doStmt.source;
const parser::Block &block{std::get<parser::Block>(doConstruct.t)};
DoConcurrentBodyEnforce doConcurrentBodyEnforce{context_};
DoConcurrentBodyEnforce doConcurrentBodyEnforce{context_, doStmt.source};
parser::Walk(block, doConcurrentBodyEnforce);
DoConcurrentLabelEnforce doConcurrentLabelEnforce{context_,
@ -519,7 +476,7 @@ private:
const parser::CharBlock &name{ref->name()};
context_
.Say(currentStatementSourcePosition_,
"concurrent-header mask expression cannot reference an impure"
"Concurrent-header mask expression cannot reference an impure"
" procedure"_err_en_US)
.Attach(name, "Declaration of impure procedure '%s'"_en_US, name);
return;
@ -558,7 +515,8 @@ private:
mask.thing.thing.value().source);
}
// C1129, names in local locality-specs can't be in limit or step expressions
// C1129, names in local locality-specs can't be in limit or step
// expressions
void CheckExprDoesNotReferenceLocal(
const parser::ScalarIntExpr &expr, const SymbolSet &localVars) const {
CheckNoCollisions(GatherSymbolsFromExpression(expr.thing.thing.value()),
@ -568,8 +526,8 @@ private:
expr.thing.thing.value().source);
}
// C1130, default(none) locality requires names to be in locality-specs to be
// used in the body of the DO loop
// C1130, DEFAULT(NONE) locality requires names to be in locality-specs to
// be used in the body of the DO loop
void CheckDefaultNoneImpliesExplicitLocality(
const std::list<parser::LocalitySpec> &localitySpecs,
const parser::Block &block) const {
@ -579,7 +537,7 @@ private:
if (hasDefaultNone) {
// C1127, you can only have one DEFAULT(NONE)
context_.Say(currentStatementSourcePosition_,
"only one DEFAULT(NONE) may appear"_en_US);
"Only one DEFAULT(NONE) may appear"_en_US);
break;
}
hasDefaultNone = true;
@ -710,16 +668,17 @@ void DoChecker::CheckForBadLeave(
common::visitors{
[&](const parser::DoConstruct *doConstructPtr) {
if (doConstructPtr->IsDoConcurrent()) {
// C1135 and C1167
// C1135 and C1167 -- CYCLE and EXIT statements can't leave a
// DO CONCURRENT
SayBadLeave(stmtType, "DO CONCURRENT", construct);
}
},
[&](const parser::CriticalConstruct *) {
// C1135 and C1168
// C1135 and C1168 -- similarly, for CRITICAL
SayBadLeave(stmtType, "CRITICAL", construct);
},
[&](const parser::ChangeTeamConstruct *) {
// C1135 and C1168
// C1135 and C1168 -- similarly, for CHANGE TEAM
SayBadLeave(stmtType, "CHANGE TEAM", construct);
},
[](const auto *) {},
@ -748,10 +707,10 @@ void DoChecker::CheckDoConcurrentExit(
}
}
// Check nesting violations for a CYCLE or EXIT statement. Loop up the nesting
// levels looking for a construct that matches the CYCLE or EXIT statment. At
// every construct, check for a violation. If we find a match without finding
// a violation, the check is complete.
// Check nesting violations for a CYCLE or EXIT statement. Loop up the
// nesting levels looking for a construct that matches the CYCLE or EXIT
// statment. At every construct, check for a violation. If we find a match
// without finding a violation, the check is complete.
void DoChecker::CheckNesting(
StmtType stmtType, const parser::Name *stmtName) const {
const ConstructStack &stack{context_.constructStack()};
@ -773,12 +732,12 @@ void DoChecker::CheckNesting(
}
}
// C1135
// C1135 -- Nesting for CYCLE statements
void DoChecker::Enter(const parser::CycleStmt &cycleStmt) {
CheckNesting(StmtType::CYCLE, common::GetPtrFromOptional(cycleStmt.v));
}
// C1167 and C1168
// C1167 and C1168 -- Nesting for EXIT statements
void DoChecker::Enter(const parser::ExitStmt &exitStmt) {
CheckNesting(StmtType::EXIT, common::GetPtrFromOptional(exitStmt.v));
}

2
flang/lib/semantics/check-do.h
View File

@ -27,7 +27,7 @@ struct ExitStmt;
namespace Fortran::semantics {
// To specify different statement types used in semantic checking.
ENUM_CLASS(StmtType, CYCLE, EXIT, ALLOCATE, DEALLOCATE)
ENUM_CLASS(StmtType, CYCLE, EXIT)
class DoChecker : public virtual BaseChecker {
public:

137
flang/lib/semantics/tools.cc
View File

@ -21,6 +21,7 @@
#include "../common/indirection.h"
#include "../parser/message.h"
#include "../parser/parse-tree.h"
#include "../parser/tools.h"
#include <algorithm>
#include <set>
#include <variant>
@ -541,6 +542,138 @@ std::unique_ptr<parser::Message> WhyNotModifiable(parser::CharBlock at,
return {};
}
struct ImageControlStmtHelper {
using ImageControlStmts = std::variant<parser::ChangeTeamConstruct,
parser::CriticalConstruct, parser::EventPostStmt, parser::EventWaitStmt,
parser::FormTeamStmt, parser::LockStmt, parser::StopStmt,
parser::SyncAllStmt, parser::SyncImagesStmt, parser::SyncMemoryStmt,
parser::SyncTeamStmt, parser::UnlockStmt>;
template<typename T> bool operator()(const T &) {
return common::HasMember<T, ImageControlStmts>;
}
template<typename T> bool operator()(const common::Indirection<T> &x) {
return (*this)(x.value());
}
bool IsCoarrayObject(const parser::AllocateObject &allocateObject) {
const parser::Name &name{GetLastName(allocateObject)};
return name.symbol && IsCoarray(*name.symbol);
}
bool operator()(const parser::AllocateStmt &stmt) {
const auto &allocationList{std::get<std::list<parser::Allocation>>(stmt.t)};
for (const auto &allocation : allocationList) {
const auto &allocateObject{
std::get<parser::AllocateObject>(allocation.t)};
if (IsCoarrayObject(allocateObject)) {
return true;
}
}
return false;
}
bool operator()(const parser::DeallocateStmt &stmt) {
const auto &allocateObjectList{
std::get<std::list<parser::AllocateObject>>(stmt.t)};
for (const auto &allocateObject : allocateObjectList) {
if (IsCoarrayObject(allocateObject)) {
return true;
}
}
return false;
}
bool operator()(const parser::CallStmt &stmt) {
const auto &procedureDesignator{
std::get<parser::ProcedureDesignator>(stmt.v.t)};
if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
// TODO: also ensure that the procedure is, in fact, an intrinsic
if (name->source == "move_alloc") {
const auto &args{std::get<std::list<parser::ActualArgSpec>>(stmt.v.t)};
if (!args.empty()) {
const parser::ActualArg &actualArg{
std::get<parser::ActualArg>(args.front().t)};
if (const auto *argExpr{
std::get_if<common::Indirection<parser::Expr>>(
&actualArg.u)}) {
return HasCoarray(argExpr->value());
}
}
}
}
return false;
}
bool operator()(const parser::Statement<parser::ActionStmt> &stmt) {
return std::visit(*this, stmt.statement.u);
}
};
bool IsImageControlStmt(const parser::ExecutableConstruct &construct) {
return std::visit(ImageControlStmtHelper{}, construct.u);
}
std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
const parser::ExecutableConstruct &construct) {
if (const auto *actionStmt{
std::get_if<parser::Statement<parser::ActionStmt>>(&construct.u)}) {
return std::visit(
common::visitors{
[](const common::Indirection<parser::AllocateStmt> &)
-> std::optional<parser::MessageFixedText> {
return "ALLOCATE of a coarray is an image control"
" statement"_en_US;
},
[](const common::Indirection<parser::DeallocateStmt> &)
-> std::optional<parser::MessageFixedText> {
return "DEALLOCATE of a coarray is an image control"
" statement"_en_US;
},
[](const common::Indirection<parser::CallStmt> &)
-> std::optional<parser::MessageFixedText> {
return "MOVE_ALLOC of a coarray is an image control"
" statement "_en_US;
},
[](const auto &) -> std::optional<parser::MessageFixedText> {
return std::nullopt;
},
},
actionStmt->statement.u);
}
return std::nullopt;
}
const parser::CharBlock GetImageControlStmtLocation(
const parser::ExecutableConstruct &executableConstruct) {
return std::visit(
common::visitors{
[](const common::Indirection<parser::ChangeTeamConstruct>
&construct) {
return std::get<parser::Statement<parser::ChangeTeamStmt>>(
construct.value().t)
.source;
},
[](const common::Indirection<parser::CriticalConstruct> &construct) {
return std::get<parser::Statement<parser::CriticalStmt>>(
construct.value().t)
.source;
},
[](const parser::Statement<parser::ActionStmt> &actionStmt) {
return actionStmt.source;
},
[](const auto &) { return parser::CharBlock{}; },
},
executableConstruct.u);
}
bool HasCoarray(const parser::Expr &expression) {
if (const auto *expr{GetExpr(expression)}) {
for (const Symbol *symbol : evaluate::CollectSymbols(*expr)) {
if (const Symbol * root{GetAssociationRoot(DEREF(symbol))}) {
if (IsCoarray(*root)) {
return true;
}
}
}
}
return false;
}
static const DeclTypeSpec &InstantiateIntrinsicType(Scope &scope,
const DeclTypeSpec &spec, SemanticsContext &semanticsContext) {
const IntrinsicTypeSpec *intrinsic{spec.AsIntrinsic()};
@ -906,8 +1039,8 @@ enum class ComponentVisitState { Resume, Pre, Post };
template<ComponentKind componentKind>
void ComponentIterator<componentKind>::const_iterator::Increment() {
std::int64_t level{static_cast<std::int64_t>(componentPath_.size()) - 1};
// Need to know if this is the first incrementation or if the visit is resumed
// after a user increment.
// Need to know if this is the first incrementation or if the visit is
// resumed after a user increment.
ComponentVisitState state{
level >= 0 && GetComponentSymbol(componentPath_[level])
? ComponentVisitState::Resume

14
flang/lib/semantics/tools.h
View File

@ -120,12 +120,24 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
}
bool IsAssumedLengthCharacter(const Symbol &);
bool IsAssumedLengthCharacterFunction(const Symbol &);
// Is the symbol modifiable in this scope
std::optional<parser::MessageFixedText> WhyNotModifiable(
const Symbol &, const Scope &);
std::unique_ptr<parser::Message> WhyNotModifiable(SourceName, const SomeExpr &,
const Scope &, bool vectorSubscriptIsOk = false);
// Is the symbol modifiable in this scope
bool IsExternalInPureContext(const Symbol &symbol, const Scope &scope);
bool HasCoarray(const parser::Expr &expression);
// Analysis of image control statements
bool IsImageControlStmt(const parser::ExecutableConstruct &);
// Get the location of the image control statement in this ExecutableConstruct
const parser::CharBlock GetImageControlStmtLocation(
const parser::ExecutableConstruct &);
// Image control statements that reference coarrays need an extra message
// to clarify why they're image control statements. This function returns
// std::nullopt for ExecutableConstructs that do not require an extra message
std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
const parser::ExecutableConstruct &);
// Returns the complete list of derived type parameter symbols in
// the order in which their declarations appear in the derived type

1
flang/test/semantics/CMakeLists.txt
View File

@ -242,7 +242,6 @@ set(DOCONCURRENT_TESTS
doconcurrent03.f90
doconcurrent04.f90
doconcurrent07.f90
doconcurrent08.f90
)
set(CANONDO_TESTS

114
flang/test/semantics/doconcurrent01.f90
View File

@ -13,9 +13,8 @@
! limitations under the License.
!
! C1141
! A reference to the procedure IEEE_GET_FLAG, IEEE_SET_HALTING_MODE, or
! IEEE_GET_HALTING_MODE from the intrinsic module IEEE_EXCEPTIONS, shall not
! appear within a DO CONCURRENT construct.
! A reference to the procedure IEEE_SET_HALTING_MODE ! from the intrinsic
! module IEEE_EXCEPTIONS, shall not ! appear within a DO CONCURRENT construct.
!
! C1137
! An image control statement shall not appear within a DO CONCURRENT construct.
@ -30,13 +29,13 @@ subroutine do_concurrent_test1(i,n)
implicit none
integer :: i, n
do 10 concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
SYNC ALL
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
SYNC IMAGES (*)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
SYNC MEMORY
!ERROR: RETURN not allowed in DO CONCURRENT
!ERROR: RETURN is not allowed in DO CONCURRENT
return
10 continue
end subroutine do_concurrent_test1
@ -50,32 +49,35 @@ subroutine do_concurrent_test2(i,j,n,flag)
logical :: flagValue, halting
type(team_type) :: j
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
sync team (j)
!ERROR: An image control statement is not allowed in DO CONCURRENT
change team (j)
!ERROR: An image control statement is not allowed in DO CONCURRENT
critical
!ERROR: call to impure procedure in DO CONCURRENT not allowed
!ERROR: IEEE_GET_FLAG not allowed in DO CONCURRENT
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
call ieee_get_flag(flag, flagValue)
!ERROR: call to impure procedure in DO CONCURRENT not allowed
!ERROR: IEEE_GET_HALTING_MODE not allowed in DO CONCURRENT
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
call ieee_get_halting_mode(flag, halting)
!ERROR: IEEE_SET_HALTING_MODE not allowed in DO CONCURRENT
!ERROR: IEEE_SET_HALTING_MODE is not allowed in DO CONCURRENT
call ieee_set_halting_mode(flag, halting)
!ERROR: image control statement not allowed in DO CONCURRENT
end critical
!ERROR: image control statement not allowed in DO CONCURRENT
end team
!ERROR: ADVANCE specifier not allowed in DO CONCURRENT
!ERROR: ADVANCE specifier is not allowed in DO CONCURRENT
write(*,'(a35)',advance='no')
end do
! The following is OK
do concurrent (i = 1:n)
call ieee_set_flag(flag, flagValue)
end do
end subroutine do_concurrent_test2
subroutine s1()
use iso_fortran_env
type(event_type) :: x
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
event post (x)
end do
end subroutine s1
@ -84,7 +86,7 @@ subroutine s2()
use iso_fortran_env
type(event_type) :: x
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
event wait (x)
end do
end subroutine s2
@ -94,7 +96,7 @@ subroutine s3()
type(team_type) :: t
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
form team(1, t)
end do
end subroutine s3
@ -104,22 +106,17 @@ subroutine s4()
type(lock_type) :: l
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
lock(l)
!ERROR: image control statement not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
unlock(l)
end do
end subroutine s4
subroutine s5()
use iso_fortran_env
type(lock_type) :: l
do concurrent (i = 1:n)
!ERROR: image control statement not allowed in DO CONCURRENT
lock(l)
!ERROR: image control statement not allowed in DO CONCURRENT
unlock(l)
!ERROR: An image control statement is not allowed in DO CONCURRENT
stop
end do
end subroutine s5
@ -133,52 +130,77 @@ subroutine s6()
type(type0) :: type1_field
end type
type(type1), allocatable :: pvar;
type(type1), allocatable :: qvar;
type(type1) :: pvar;
type(type1) :: qvar;
integer, allocatable, dimension(:) :: array1
integer, allocatable, dimension(:) :: array2
integer, allocatable, codimension[*] :: ca
integer, allocatable, codimension[*] :: ca, cb
integer, allocatable :: aa, ab
! All of the following are allowable outside a DO CONCURRENT
allocate(pvar)
allocate(array1(3), pvar%type1_field%type0_field(3), array2(9))
allocate(pvar%type1_field%coarray_type0_field(3)[*])
allocate(ca[*])
allocate(pvar, ca[*], qvar, pvar%type1_field%coarray_type0_field(3)[*])
allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
do concurrent (i = 1:10)
allocate(pvar%type1_field%type0_field(3))
allocate(pvar%type1_field%type0_field(3))
end do
do concurrent (i = 1:10)
!ERROR: ALLOCATE coarray not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
allocate(ca[*])
end do
do concurrent (i = 1:10)
!ERROR: DEALLOCATE coarray not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
deallocate(ca)
end do
do concurrent (i = 1:10)
!ERROR: ALLOCATE coarray not allowed in DO CONCURRENT
allocate(pvar%type1_field%coarray_type0_field(3)[*])
!ERROR: An image control statement is not allowed in DO CONCURRENT
allocate(pvar%type1_field%coarray_type0_field(3)[*])
end do
do concurrent (i = 1:10)
!ERROR: DEALLOCATE coarray not allowed in DO CONCURRENT
deallocate(pvar%type1_field%coarray_type0_field)
!ERROR: An image control statement is not allowed in DO CONCURRENT
deallocate(pvar%type1_field%coarray_type0_field)
end do
do concurrent (i = 1:10)
!ERROR: ALLOCATE coarray not allowed in DO CONCURRENT
!ERROR: ALLOCATE coarray not allowed in DO CONCURRENT
allocate(pvar, ca[*], qvar, pvar%type1_field%coarray_type0_field(3)[*])
!ERROR: An image control statement is not allowed in DO CONCURRENT
allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
end do
do concurrent (i = 1:10)
!ERROR: DEALLOCATE coarray not allowed in DO CONCURRENT
!ERROR: DEALLOCATE coarray not allowed in DO CONCURRENT
deallocate(pvar, ca, qvar, pvar%type1_field%coarray_type0_field)
!ERROR: An image control statement is not allowed in DO CONCURRENT
deallocate(ca, pvar%type1_field%coarray_type0_field)
end do
! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT. This is OK.
call move_alloc(ca, cb)
! Note that the errors below relating to MOVE_ALLOC() bing impure are bogus.
! They're the result of the fact that access to the move_alloc() instrinsic
! is not yet possible.
allocate(aa)
do concurrent (i = 1:10)
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
call move_alloc(aa, ab)
end do
! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.
do concurrent (i = 1:10)
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
call move_alloc(ca, cb)
end do
do concurrent (i = 1:10)
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)
end do
end subroutine s6

2
flang/test/semantics/doconcurrent03.f90
View File

@ -13,7 +13,7 @@
! limitations under the License.
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
! CHECK: control flow escapes from DO CONCURRENT
! CHECK: Control flow escapes from DO CONCURRENT
! CHECK: branch into loop body from outside
! CHECK: the loop branched into

25
flang/test/semantics/doconcurrent08.f90
View File

@ -1,25 +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
! CHECK: image control statement not allowed in DO CONCURRENT
! CHECK: SYNC ALL
subroutine do_concurrent_test1(i,n)
implicit none
integer :: i, n
do 10 concurrent (i = 1:n)
SYNC ALL
10 continue
end subroutine do_concurrent_test1

2
flang/test/semantics/dosemantics02.f90
View File

@ -17,7 +17,7 @@
SUBROUTINE do_concurrent_c1121(i,n)
IMPLICIT NONE
INTEGER :: i, n, flag
!ERROR: concurrent-header mask expression cannot reference an impure procedure
!ERROR: Concurrent-header mask expression cannot reference an impure procedure
DO CONCURRENT (i = 1:n, random() < 3)
flag = 3
END DO

2
flang/test/semantics/dosemantics08.f90
View File

@ -18,7 +18,7 @@
subroutine s1()
do concurrent (i=1:10)
!ERROR: control flow escapes from DO CONCURRENT
!ERROR: Control flow escapes from DO CONCURRENT
goto 99
end do