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

[flang] Add FORALL checking to DoChecker 

FORALL statements and constructs require a lot of the same checking
as DO CONCURRENT, so do the checks in DoChecker so that code can be
shared where possible. This requires some reorganization there.
Remove code from AssignmentChecker that did some of these checks.

Change names that contain `DoVar` or `DoVariable` to `IndexVar` to
reflect the fact that they may be DO or FORALL index variables.
Distinguish between the two when necessary with enum `IndexVarKind`.

Change some messages that referred to "concurrent-header" or
"concurrent-control" to specifically say "DO CONCURRENT" or "FORALL".

Original-commit: flang-compiler/f18@84752c492e
Reviewed-on: https://github.com/flang-compiler/f18/pull/989
Tree-same-pre-rewrite: false
This commit is contained in:
Tim Keith 2020-02-18 17:14:24 -08:00
parent 88aa96ffe9
commit ee7cc4764f
18 changed files with 300 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
flang/include/flang/evaluate/tools.h
View File

@ -843,5 +843,8 @@ parser::Message *SayWithDeclaration(
// of one to complain about, if any exist.
std::optional<std::string> FindImpureCall(
const IntrinsicProcTable &, const Expr<SomeType> &);
std::optional<std::string> FindImpureCall(
const IntrinsicProcTable &, const ProcedureRef &);
}
#endif // FORTRAN_EVALUATE_TOOLS_H_

27
flang/include/flang/semantics/semantics.h
View File

@ -150,19 +150,18 @@ public:
}
void PopConstruct();
// Check to see if a variable being redefined is a DO variable. If so, emit
// a message
void WarnDoVarRedefine(const parser::CharBlock &, const Symbol &);
void CheckDoVarRedefine(const parser::CharBlock &, const Symbol &);
void CheckDoVarRedefine(const parser::Variable &);
void CheckDoVarRedefine(const parser::Name &);
void ActivateDoVariable(const parser::Name &);
void DeactivateDoVariable(const parser::Name &);
bool IsActiveDoVariable(const Symbol &);
ENUM_CLASS(IndexVarKind, DO, FORALL)
// Check to see if a variable being redefined is a DO or FORALL index.
// If so, emit a message.
void WarnIndexVarRedefine(const parser::CharBlock &, const Symbol &);
void CheckIndexVarRedefine(const parser::CharBlock &, const Symbol &);
void CheckIndexVarRedefine(const parser::Variable &);
void CheckIndexVarRedefine(const parser::Name &);
void ActivateIndexVar(const parser::Name &, IndexVarKind);
void DeactivateIndexVar(const parser::Name &);
private:
parser::CharBlock GetDoVariableLocation(const Symbol &);
void CheckDoVarRedefine(
void CheckIndexVarRedefine(
const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
const common::IntrinsicTypeDefaultKinds &defaultKinds_;
const common::LanguageFeatureControl languageFeatures_;
@ -180,7 +179,11 @@ private:
bool CheckError(bool);
ConstructStack constructStack_;
std::map<SymbolRef, const parser::CharBlock> activeDoVariables_;
struct IndexVarInfo {
parser::CharBlock location;
IndexVarKind kind;
};
std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
};
class Semantics {

4
flang/lib/evaluate/tools.cpp
View File

@ -842,5 +842,9 @@ std::optional<std::string> FindImpureCall(
const IntrinsicProcTable &intrinsics, const Expr<SomeType> &expr) {
return FindImpureCallHelper{intrinsics}(expr);
}
std::optional<std::string> FindImpureCall(
const IntrinsicProcTable &intrinsics, const ProcedureRef &proc) {
return FindImpureCallHelper{intrinsics}(proc);
}
}

124
flang/lib/semantics/assignment.cpp
View File

@ -46,20 +46,8 @@ struct Control {
struct ForallContext {
explicit ForallContext(const ForallContext *that) : outer{that} {}
std::optional<int> GetActiveIntKind(const parser::CharBlock &name) const {
const auto iter{activeNames.find(name)};
if (iter != activeNames.cend()) {
return {integerKind};
} else if (outer) {
return outer->GetActiveIntKind(name);
} else {
return std::nullopt;
}
}
const ForallContext *outer{nullptr};
std::optional<parser::CharBlock> constructName;
int integerKind;
std::vector<Control> control;
std::optional<MaskExpr> maskExpr;
std::set<parser::CharBlock> activeNames;
@ -89,10 +77,7 @@ public:
void Analyze(const parser::PointerAssignmentStmt &);
void Analyze(const parser::WhereStmt &);
void Analyze(const parser::WhereConstruct &);
void Analyze(const parser::ForallStmt &);
void Analyze(const parser::ForallConstruct &);
void Analyze(const parser::ForallConstructStmt &);
void Analyze(const parser::ConcurrentHeader &);
template<typename A> void Analyze(const parser::UnlabeledStatement<A> &stmt) {
context_.set_location(stmt.source);
@ -120,9 +105,6 @@ private:
void Analyze(const parser::MaskedElsewhereStmt &);
void Analyze(const parser::WhereConstruct::Elsewhere &);
int GetIntegerKind(const std::optional<parser::IntegerTypeSpec> &);
void CheckForImpureCall(const SomeExpr &);
void CheckForImpureCall(const SomeExpr *);
void CheckForPureContext(const SomeExpr &lhs, const SomeExpr &rhs,
parser::CharBlock rhsSource, bool isPointerAssignment);
@ -142,8 +124,6 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
// Assignment statement analysis is in expression.cpp where user-defined
// assignments can be recognized and replaced.
if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
CheckForImpureCall(assignment->lhs);
CheckForImpureCall(assignment->rhs);
if (forall_) {
// TODO: Warn if some name in forall_->activeNames or its outer
// contexts does not appear on LHS
@ -163,22 +143,6 @@ void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
}
const SomeExpr &lhs{assignment->lhs};
const SomeExpr &rhs{assignment->rhs};
CheckForImpureCall(lhs);
CheckForImpureCall(rhs);
std::visit(
common::visitors{[&](const evaluate::Assignment::BoundsSpec &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound});
}
},
[&](const evaluate::Assignment::BoundsRemapping &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound.first});
CheckForImpureCall(SomeExpr{bound.second});
}
},
[](const auto &) { DIE("not valid for pointer assignment"); }},
assignment->u);
if (forall_) {
// TODO: Warn if some name in forall_->activeNames or its outer
// contexts does not appear on LHS
@ -216,32 +180,6 @@ void AssignmentContext::Analyze(const parser::WhereConstruct &construct) {
std::get<std::optional<parser::WhereConstruct::Elsewhere>>(construct.t));
}
void AssignmentContext::Analyze(const parser::ForallStmt &stmt) {
CHECK(!where_);
ForallContext forall{forall_};
AssignmentContext nested{*this, forall};
nested.Analyze(
std::get<common::Indirection<parser::ConcurrentHeader>>(stmt.t));
nested.Analyze(
std::get<parser::UnlabeledStatement<parser::ForallAssignmentStmt>>(
stmt.t));
}
// N.B. Construct name matching is checked during label resolution;
// index name distinction is checked during name resolution.
void AssignmentContext::Analyze(const parser::ForallConstruct &construct) {
CHECK(!where_);
ForallContext forall{forall_};
AssignmentContext nested{*this, forall};
nested.Analyze(
std::get<parser::Statement<parser::ForallConstructStmt>>(construct.t));
nested.Analyze(std::get<std::list<parser::ForallBodyConstruct>>(construct.t));
}
void AssignmentContext::Analyze(const parser::ForallConstructStmt &stmt) {
Analyze(std::get<common::Indirection<parser::ConcurrentHeader>>(stmt.t));
}
void AssignmentContext::Analyze(
const parser::WhereConstruct::MaskedElsewhere &elsewhere) {
CHECK(where_);
@ -279,56 +217,6 @@ void AssignmentContext::Analyze(
Analyze(std::get<std::list<parser::WhereBodyConstruct>>(elsewhere.t));
}
void AssignmentContext::Analyze(const parser::ConcurrentHeader &header) {
DEREF(forall_).integerKind = GetIntegerKind(
std::get<std::optional<parser::IntegerTypeSpec>>(header.t));
for (const auto &control :
std::get<std::list<parser::ConcurrentControl>>(header.t)) {
const parser::Name &name{std::get<parser::Name>(control.t)};
bool inserted{forall_->activeNames.insert(name.source).second};
CHECK(inserted || context_.HasError(name));
CheckForImpureCall(GetExpr(std::get<1>(control.t)));
CheckForImpureCall(GetExpr(std::get<2>(control.t)));
if (const auto &stride{std::get<3>(control.t)}) {
CheckForImpureCall(GetExpr(*stride));
}
}
if (const auto &mask{
std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {
CheckForImpureCall(GetExpr(*mask));
}
}
int AssignmentContext::GetIntegerKind(
const std::optional<parser::IntegerTypeSpec> &spec) {
std::optional<parser::KindSelector> empty;
evaluate::Expr<evaluate::SubscriptInteger> kind{AnalyzeKindSelector(
context_, TypeCategory::Integer, spec ? spec->v : empty)};
if (auto value{evaluate::ToInt64(kind)}) {
return static_cast<int>(*value);
} else {
context_.Say("Kind of INTEGER type must be a constant value"_err_en_US);
return context_.GetDefaultKind(TypeCategory::Integer);
}
}
void AssignmentContext::CheckForImpureCall(const SomeExpr &expr) {
if (forall_) {
const auto &intrinsics{context_.foldingContext().intrinsics()};
if (auto bad{FindImpureCall(intrinsics, expr)}) {
context_.Say(
"Impure procedure '%s' may not be referenced in a FORALL"_err_en_US,
*bad);
}
}
}
void AssignmentContext::CheckForImpureCall(const SomeExpr *expr) {
if (expr) {
CheckForImpureCall(*expr);
}
}
// C1594 checks
static bool IsPointerDummyOfPureFunction(const Symbol &x) {
return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
@ -449,18 +337,12 @@ MaskExpr AssignmentContext::GetMask(
const parser::LogicalExpr &logicalExpr, bool defaultValue) {
MaskExpr mask{defaultValue};
if (const SomeExpr * expr{GetExpr(logicalExpr)}) {
CheckForImpureCall(*expr);
auto *logical{std::get_if<evaluate::Expr<evaluate::SomeLogical>>(&expr->u)};
mask = evaluate::ConvertTo(mask, common::Clone(DEREF(logical)));
}
return mask;
}
void AnalyzeConcurrentHeader(
SemanticsContext &context, const parser::ConcurrentHeader &header) {
AssignmentContext{context}.Analyze(header);
}
AssignmentChecker::~AssignmentChecker() {}
AssignmentChecker::AssignmentChecker(SemanticsContext &context)
@ -477,12 +359,6 @@ void AssignmentChecker::Enter(const parser::WhereStmt &x) {
void AssignmentChecker::Enter(const parser::WhereConstruct &x) {
context_.value().Analyze(x);
}
void AssignmentChecker::Enter(const parser::ForallStmt &x) {
context_.value().Analyze(x);
}
void AssignmentChecker::Enter(const parser::ForallConstruct &x) {
context_.value().Analyze(x);
}
}
template class Fortran::common::Indirection<

17
flang/lib/semantics/assignment.h
View File

@ -12,24 +12,20 @@
#include "flang/common/indirection.h"
#include "flang/evaluate/expression.h"
#include "flang/semantics/semantics.h"
#include "flang/semantics/tools.h"
#include <string>
namespace Fortran::parser {
template<typename> struct Statement;
class ContextualMessages;
struct AssignmentStmt;
struct ConcurrentHeader;
struct ForallStmt;
struct PointerAssignmentStmt;
struct Program;
struct WhereStmt;
struct WhereConstruct;
struct ForallConstruct;
}
namespace Fortran::semantics {
class AssignmentContext;
class Scope;
class Symbol;
// Applies checks from C1594(1-2) on definitions in pure subprograms
void CheckDefinabilityInPureScope(parser::ContextualMessages &, const Symbol &,
@ -46,18 +42,11 @@ public:
void Enter(const parser::PointerAssignmentStmt &);
void Enter(const parser::WhereStmt &);
void Enter(const parser::WhereConstruct &);
void Enter(const parser::ForallStmt &);
void Enter(const parser::ForallConstruct &);
private:
common::Indirection<AssignmentContext> context_;
};
// R1125 concurrent-header is used in FORALL statements & constructs as
// well as in DO CONCURRENT loops.
void AnalyzeConcurrentHeader(
SemanticsContext &, const parser::ConcurrentHeader &);
}
extern template class Fortran::common::Indirection<

2
flang/lib/semantics/check-allocate.cpp
View File

@ -531,7 +531,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
"Allocatable object declared here with rank %d"_en_US, rank_);
return false;
}
context.CheckDoVarRedefine(name_);
context.CheckIndexVarRedefine(name_);
return RunCoarrayRelatedChecks(context);
}

2
flang/lib/semantics/check-deallocate.cpp
View File

@ -30,7 +30,7 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
context_.Say(name.source,
"name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
} else {
context_.CheckDoVarRedefine(name);
context_.CheckIndexVarRedefine(name);
}
},
[&](const parser::StructureComponent &structureComponent) {

229
flang/lib/semantics/check-do.cpp
View File

@ -34,13 +34,31 @@ namespace Fortran::semantics {
using namespace parser::literals;
using Bounds = parser::LoopControl::Bounds;
using IndexVarKind = SemanticsContext::IndexVarKind;
static const std::list<parser::ConcurrentControl> &GetControls(
static const parser::ConcurrentHeader &GetConcurrentHeader(
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);
return std::get<parser::ConcurrentHeader>(concurrent.t);
}
static const parser::ConcurrentHeader &GetConcurrentHeader(
const parser::ForallConstruct &construct) {
const auto &stmt{
std::get<parser::Statement<parser::ForallConstructStmt>>(construct.t)};
return std::get<common::Indirection<parser::ConcurrentHeader>>(
stmt.statement.t)
.value();
}
static const parser::ConcurrentHeader &GetConcurrentHeader(
const parser::ForallStmt &stmt) {
return std::get<common::Indirection<parser::ConcurrentHeader>>(stmt.t)
.value();
}
template<typename T>
static const std::list<parser::ConcurrentControl> &GetControls(const T &x) {
return std::get<std::list<parser::ConcurrentControl>>(
GetConcurrentHeader(x).t);
}
static const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {
@ -366,10 +384,11 @@ private:
const Scope &blockScope_;
}; // class DoConcurrentVariableEnforce
// Find a DO statement and enforce semantics checks on its body
// Find a DO or FORALL and enforce semantics checks on its body
class DoContext {
public:
DoContext(SemanticsContext &context) : context_{context} {}
DoContext(SemanticsContext &context, IndexVarKind kind)
: context_{context}, kind_{kind} {}
// 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
@ -378,13 +397,10 @@ public:
// the DO construct and use its location in error messages.
void DefineDoVariables(const parser::DoConstruct &doConstruct) {
if (doConstruct.IsDoNormal()) {
context_.ActivateDoVariable(GetDoVariable(doConstruct));
context_.ActivateIndexVar(GetDoVariable(doConstruct), IndexVarKind::DO);
} 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));
}
ActivateIndexVars(GetControls(*loopControl));
}
}
}
@ -392,17 +408,26 @@ public:
// 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));
context_.DeactivateIndexVar(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));
}
DeactivateIndexVars(GetControls(*loopControl));
}
}
}
void ActivateIndexVars(const std::list<parser::ConcurrentControl> &controls) {
for (const auto &control : controls) {
context_.ActivateIndexVar(std::get<parser::Name>(control.t), kind_);
}
}
void DeactivateIndexVars(
const std::list<parser::ConcurrentControl> &controls) {
for (const auto &control : controls) {
context_.DeactivateIndexVar(std::get<parser::Name>(control.t));
}
}
void Check(const parser::DoConstruct &doConstruct) {
if (doConstruct.IsDoConcurrent()) {
CheckDoConcurrent(doConstruct);
@ -415,6 +440,46 @@ public:
// TODO: handle the other cases
}
void Check(const parser::ForallStmt &stmt) {
CheckConcurrentHeader(GetConcurrentHeader(stmt));
}
void Check(const parser::ForallConstruct &construct) {
CheckConcurrentHeader(GetConcurrentHeader(construct));
}
void Check(const parser::ForallAssignmentStmt &stmt) {
const evaluate::Assignment *assignment{std::visit(
common::visitors{[&](const auto &x) { return GetAssignment(x); }},
stmt.u)};
if (assignment) {
CheckForImpureCall(assignment->lhs);
CheckForImpureCall(assignment->rhs);
if (const auto *proc{
std::get_if<evaluate::ProcedureRef>(&assignment->u)}) {
CheckForImpureCall(*proc);
}
std::visit(
common::visitors{
[](const evaluate::Assignment::Intrinsic &) {},
[&](const evaluate::ProcedureRef &proc) {
CheckForImpureCall(proc);
},
[&](const evaluate::Assignment::BoundsSpec &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound});
}
},
[&](const evaluate::Assignment::BoundsRemapping &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound.first});
CheckForImpureCall(SomeExpr{bound.second});
}
},
},
assignment->u);
}
}
private:
void SayBadDoControl(parser::CharBlock sourceLocation) {
context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
@ -493,11 +558,9 @@ private:
"DO CONCURRENT"};
parser::Walk(block, doConcurrentLabelEnforce);
const auto &loopControl{
std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
const auto &concurrent{
std::get<parser::LoopControl::Concurrent>(loopControl->u)};
CheckConcurrentLoopControl(concurrent, block);
const auto &loopControl{doConstruct.GetLoopControl()};
CheckConcurrentLoopControl(*loopControl);
CheckLocalitySpecs(*loopControl, block);
}
// Return a set of symbols whose names are in a Local locality-spec. Look
@ -543,9 +606,9 @@ private:
SymbolSet references{GatherSymbolsFromExpression(mask.thing.thing.value())};
for (const Symbol &ref : references) {
if (IsProcedure(ref) && !IsPureProcedure(ref)) {
context_.SayWithDecl(ref, currentStatementSourcePosition_,
"Concurrent-header mask expression cannot reference an impure"
" procedure"_err_en_US);
context_.SayWithDecl(ref, parser::Unwrap<parser::Expr>(mask)->source,
"%s mask expression may not reference impure procedure '%s'"_err_en_US,
LoopKindName(), ref.name());
return;
}
}
@ -556,8 +619,8 @@ private:
const parser::CharBlock &refPosition) const {
for (const Symbol &ref : refs) {
if (uses.find(ref) != uses.end()) {
context_.SayWithDecl(
ref, refPosition, std::move(errorMessage), ref.name());
context_.SayWithDecl(ref, refPosition, std::move(errorMessage),
LoopKindName(), ref.name());
return;
}
}
@ -567,7 +630,7 @@ private:
const SymbolSet &indexNames, const parser::ScalarIntExpr &expr) const {
CheckNoCollisions(GatherSymbolsFromExpression(expr.thing.thing.value()),
indexNames,
"concurrent-control expression references index-name '%s'"_err_en_US,
"%s limit expression may not reference index variable '%s'"_err_en_US,
expr.thing.thing.value().source);
}
@ -576,7 +639,7 @@ private:
const parser::ScalarLogicalExpr &mask, const SymbolSet &localVars) const {
CheckNoCollisions(GatherSymbolsFromExpression(mask.thing.thing.value()),
localVars,
"concurrent-header mask-expr references variable '%s'"
"%s mask expression references variable '%s'"
" in LOCAL locality-spec"_err_en_US,
mask.thing.thing.value().source);
}
@ -587,7 +650,7 @@ private:
const parser::ScalarIntExpr &expr, const SymbolSet &localVars) const {
CheckNoCollisions(GatherSymbolsFromExpression(expr.thing.thing.value()),
localVars,
"concurrent-header expression references variable '%s'"
"%s expression references variable '%s'"
" in LOCAL locality-spec"_err_en_US,
expr.thing.thing.value().source);
}
@ -618,40 +681,47 @@ private:
// C1123, concurrent limit or step expressions can't reference index-names
void CheckConcurrentHeader(const parser::ConcurrentHeader &header) const {
if (const auto &mask{
std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {
CheckMaskIsPure(*mask);
}
auto &controls{std::get<std::list<parser::ConcurrentControl>>(header.t)};
SymbolSet indexNames;
for (const auto &c : controls) {
const auto &indexName{std::get<parser::Name>(c.t)};
for (const parser::ConcurrentControl &control : controls) {
const auto &indexName{std::get<parser::Name>(control.t)};
if (indexName.symbol) {
indexNames.insert(*indexName.symbol);
}
}
if (!indexNames.empty()) {
for (const auto &c : controls) {
HasNoReferences(indexNames, std::get<1>(c.t));
HasNoReferences(indexNames, std::get<2>(c.t));
if (const auto &expr{
std::get<std::optional<parser::ScalarIntExpr>>(c.t)}) {
HasNoReferences(indexNames, *expr);
if (IsZero(*expr)) {
context_.Say(expr->thing.thing.value().source,
"DO CONCURRENT step expression should not be zero"_err_en_US);
for (const parser::ConcurrentControl &control : controls) {
HasNoReferences(indexNames, std::get<1>(control.t));
HasNoReferences(indexNames, std::get<2>(control.t));
if (const auto &intExpr{
std::get<std::optional<parser::ScalarIntExpr>>(control.t)}) {
const parser::Expr &expr{intExpr->thing.thing.value()};
CheckNoCollisions(GatherSymbolsFromExpression(expr), indexNames,
"%s step expression may not reference index variable '%s'"_err_en_US,
expr.source);
if (IsZero(expr)) {
context_.Say(expr.source,
"%s step expression may not be zero"_err_en_US, LoopKindName());
}
}
}
}
}
void CheckLocalitySpecs(const parser::LoopControl::Concurrent &concurrent,
const parser::Block &block) const {
void CheckLocalitySpecs(
const parser::LoopControl &control, const parser::Block &block) const {
const auto &concurrent{
std::get<parser::LoopControl::Concurrent>(control.u)};
const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
const auto &controls{
std::get<std::list<parser::ConcurrentControl>>(header.t)};
const auto &localitySpecs{
std::get<std::list<parser::LocalitySpec>>(concurrent.t)};
if (!localitySpecs.empty()) {
const SymbolSet &localVars{GatherLocals(localitySpecs)};
for (const auto &c : controls) {
for (const auto &c : GetControls(control)) {
CheckExprDoesNotReferenceLocal(std::get<1>(c.t), localVars);
CheckExprDoesNotReferenceLocal(std::get<2>(c.t), localVars);
if (const auto &expr{
@ -668,35 +738,66 @@ private:
}
// check constraints [C1121 .. C1130]
void CheckConcurrentLoopControl(
const parser::LoopControl::Concurrent &concurrent,
const parser::Block &block) const {
void CheckConcurrentLoopControl(const parser::LoopControl &control) const {
const auto &concurrent{
std::get<parser::LoopControl::Concurrent>(control.u)};
CheckConcurrentHeader(std::get<parser::ConcurrentHeader>(concurrent.t));
}
const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
const auto &mask{
std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)};
if (mask) {
CheckMaskIsPure(*mask);
template<typename T> void CheckForImpureCall(const T &x) {
const auto &intrinsics{context_.foldingContext().intrinsics()};
if (auto bad{FindImpureCall(intrinsics, x)}) {
context_.Say(
"Impure procedure '%s' may not be referenced in a %s"_err_en_US, *bad,
LoopKindName());
}
CheckConcurrentHeader(header);
CheckLocalitySpecs(concurrent, block);
}
// For messages where the DO loop must be DO CONCURRENT, make that explicit.
const char *LoopKindName() const {
return kind_ == IndexVarKind::DO ? "DO CONCURRENT" : "FORALL";
}
SemanticsContext &context_;
const IndexVarKind kind_;
parser::CharBlock currentStatementSourcePosition_;
}; // class DoContext
void DoChecker::Enter(const parser::DoConstruct &doConstruct) {
DoContext doContext{context_};
DoContext doContext{context_, IndexVarKind::DO};
doContext.DefineDoVariables(doConstruct);
}
void DoChecker::Leave(const parser::DoConstruct &doConstruct) {
DoContext doContext{context_};
DoContext doContext{context_, IndexVarKind::DO};
doContext.Check(doConstruct);
doContext.ResetDoVariables(doConstruct);
}
void DoChecker::Enter(const parser::ForallConstruct &construct) {
DoContext doContext{context_, IndexVarKind::FORALL};
doContext.ActivateIndexVars(GetControls(construct));
}
void DoChecker::Leave(const parser::ForallConstruct &construct) {
DoContext doContext{context_, IndexVarKind::FORALL};
doContext.Check(construct);
doContext.DeactivateIndexVars(GetControls(construct));
}
void DoChecker::Enter(const parser::ForallStmt &stmt) {
DoContext doContext{context_, IndexVarKind::FORALL};
doContext.ActivateIndexVars(GetControls(stmt));
}
void DoChecker::Leave(const parser::ForallStmt &stmt) {
DoContext doContext{context_, IndexVarKind::FORALL};
doContext.Check(stmt);
doContext.DeactivateIndexVars(GetControls(stmt));
}
void DoChecker::Leave(const parser::ForallAssignmentStmt &stmt) {
DoContext doContext{context_, IndexVarKind::FORALL};
doContext.Check(stmt);
}
// Return the (possibly null) name of the ConstructNode
static const parser::Name *MaybeGetNodeName(const ConstructNode &construct) {
return std::visit(
@ -819,7 +920,7 @@ void DoChecker::Enter(const parser::ExitStmt &exitStmt) {
void DoChecker::Leave(const parser::AssignmentStmt &stmt) {
const auto &variable{std::get<parser::Variable>(stmt.t)};
context_.CheckDoVarRedefine(variable);
context_.CheckIndexVarRedefine(variable);
}
static void CheckIfArgIsDoVar(const evaluate::ActualArgument &arg,
@ -829,9 +930,9 @@ static void CheckIfArgIsDoVar(const evaluate::ActualArgument &arg,
if (const SomeExpr * argExpr{arg.UnwrapExpr()}) {
if (const Symbol * var{evaluate::UnwrapWholeSymbolDataRef(*argExpr)}) {
if (intent == common::Intent::Out) {
context.CheckDoVarRedefine(location, *var);
context.CheckIndexVarRedefine(location, *var);
} else {
context.WarnDoVarRedefine(location, *var); // INTENT(INOUT)
context.WarnIndexVarRedefine(location, *var); // INTENT(INOUT)
}
}
}
@ -873,7 +974,7 @@ 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);
context_.CheckIndexVarRedefine(newunit->v.thing.thing);
}
}
@ -909,25 +1010,25 @@ 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);
context_.CheckIndexVarRedefine(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);
context_.CheckIndexVarRedefine(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.source, *name.symbol);
context_.CheckIndexVarRedefine(name.source, *name.symbol);
}
void DoChecker::Leave(const parser::StatVariable &statVariable) {
context_.CheckDoVarRedefine(statVariable.v.thing.thing);
context_.CheckIndexVarRedefine(statVariable.v.thing.thing);
}
} // namespace Fortran::semantics

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

@ -20,6 +20,9 @@ struct CycleStmt;
struct DoConstruct;
struct ExitStmt;
struct Expr;
struct ForallAssignmentStmt;
struct ForallConstruct;
struct ForallStmt;
struct InquireSpec;
struct IoControlSpec;
struct OutputImpliedDo;
@ -40,6 +43,11 @@ public:
void Enter(const parser::CycleStmt &);
void Enter(const parser::DoConstruct &);
void Leave(const parser::DoConstruct &);
void Enter(const parser::ForallConstruct &);
void Leave(const parser::ForallConstruct &);
void Enter(const parser::ForallStmt &);
void Leave(const parser::ForallStmt &);
void Leave(const parser::ForallAssignmentStmt &s);
void Enter(const parser::ExitStmt &);
void Leave(const parser::Expr &);
void Leave(const parser::InquireSpec &);

4
flang/lib/semantics/check-io.cpp
View File

@ -509,7 +509,7 @@ 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(namelistLocation, object);
context.CheckIndexVarRedefine(namelistLocation, object);
}
}
@ -532,7 +532,7 @@ static void CheckForDoVariable(
for (const auto &item : items) {
if (const parser::Variable *
variable{std::get_if<parser::Variable>(&item.u)}) {
context.CheckDoVarRedefine(*variable);
context.CheckIndexVarRedefine(*variable);
}
}
}

71
flang/lib/semantics/semantics.cpp
View File

@ -203,78 +203,63 @@ void SemanticsContext::PopConstruct() {
constructStack_.pop_back();
}
void SemanticsContext::CheckDoVarRedefine(const parser::CharBlock &location,
void SemanticsContext::CheckIndexVarRedefine(const parser::CharBlock &location,
const Symbol &variable, parser::MessageFixedText &&message) {
if (const Symbol * root{GetAssociationRoot(variable)}) {
if (IsActiveDoVariable(*root)) {
parser::CharBlock doLoc{GetDoVariableLocation(*root)};
CHECK(doLoc != parser::CharBlock{});
Say(location, std::move(message), root->name())
.Attach(doLoc, "Enclosing DO construct"_en_US);
auto it{activeIndexVars_.find(*root)};
if (it != activeIndexVars_.end()) {
std::string kind{EnumToString(it->second.kind)};
Say(location, std::move(message), kind, root->name())
.Attach(it->second.location, "Enclosing %s construct"_en_US, kind);
}
}
}
void SemanticsContext::WarnDoVarRedefine(
void SemanticsContext::WarnIndexVarRedefine(
const parser::CharBlock &location, const Symbol &variable) {
CheckDoVarRedefine(
location, variable, "Possible redefinition of DO variable '%s'"_en_US);
CheckIndexVarRedefine(
location, variable, "Possible redefinition of %s variable '%s'"_en_US);
}
void SemanticsContext::CheckDoVarRedefine(
void SemanticsContext::CheckIndexVarRedefine(
const parser::CharBlock &location, const Symbol &variable) {
CheckDoVarRedefine(
location, variable, "Cannot redefine DO variable '%s'"_err_en_US);
CheckIndexVarRedefine(
location, variable, "Cannot redefine %s variable '%s'"_err_en_US);
}
void SemanticsContext::CheckDoVarRedefine(const parser::Variable &variable) {
void SemanticsContext::CheckIndexVarRedefine(const parser::Variable &variable) {
if (const Symbol * entity{GetLastName(variable).symbol}) {
const parser::CharBlock &sourceLocation{variable.GetSource()};
CheckDoVarRedefine(sourceLocation, *entity);
CheckIndexVarRedefine(variable.GetSource(), *entity);
}
}
void SemanticsContext::CheckDoVarRedefine(const parser::Name &name) {
const parser::CharBlock &sourceLocation{name.source};
void SemanticsContext::CheckIndexVarRedefine(const parser::Name &name) {
if (const Symbol * entity{name.symbol}) {
CheckDoVarRedefine(sourceLocation, *entity);
CheckIndexVarRedefine(name.source, *entity);
}
}
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::ActivateIndexVar(
const parser::Name &name, IndexVarKind kind) {
CheckIndexVarRedefine(name);
if (const Symbol * indexVar{name.symbol}) {
if (const Symbol * root{GetAssociationRoot(*indexVar)}) {
activeIndexVars_.emplace(*root, IndexVarInfo{name.source, kind});
}
}
}
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);
void SemanticsContext::DeactivateIndexVar(const parser::Name &name) {
if (Symbol * indexVar{name.symbol}) {
if (const Symbol * root{GetAssociationRoot(*indexVar)}) {
auto it{activeIndexVars_.find(*root)};
if (it != activeIndexVars_.end() && it->second.location == name.source) {
activeIndexVars_.erase(it);
}
}
}
}
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

4
flang/test/semantics/call11.f90
View File

@ -36,7 +36,7 @@ module m
!ERROR: Impure procedure 'impure' may not be referenced in a FORALL
a(j) = pure(impure(j)) ! C1037
end forall
!ERROR: Concurrent-header mask expression cannot reference an impure procedure
!ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
do concurrent (j=1:1, impure(j) /= 0) ! C1121
!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
a(j) = impure(j) ! C1139
@ -58,7 +58,7 @@ module m
do concurrent (j=1:1, x%tbp_pure(j) /= 0) ! ok
a(j) = x%tbp_pure(j) ! ok
end do
!ERROR: Concurrent-header mask expression cannot reference an impure procedure
!ERROR: DO CONCURRENT mask expression may not reference impure procedure 'impure'
do concurrent (j=1:1, x%tbp_impure(j) /= 0) ! C1121
!ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
a(j) = x%tbp_impure(j) ! C1139

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

@ -6,7 +6,7 @@
SUBROUTINE do_concurrent_c1121(i,n)
IMPLICIT NONE
INTEGER :: i, n, flag
!ERROR: Concurrent-header mask expression cannot reference an impure procedure
!ERROR: DO CONCURRENT mask expression may not reference impure procedure 'random'
DO CONCURRENT (i = 1:n, random() < 3)
flag = 3
END DO
@ -30,12 +30,12 @@ SUBROUTINE s1()
20 CONTINUE
! Error, no compatibility requirement for DO CONCURRENT
!ERROR: DO CONCURRENT step expression should not be zero
!ERROR: DO CONCURRENT step expression may not be zero
DO CONCURRENT (I = 1 : 10 : 0)
END DO
! Error, this time with an integer constant
!ERROR: DO CONCURRENT step expression should not be zero
!ERROR: DO CONCURRENT step expression may not be zero
DO CONCURRENT (I = 1 : 10 : constInt)
END DO
end subroutine s1

12
flang/test/semantics/dosemantics04.f90
View File

@ -4,32 +4,32 @@ PROGRAM dosemantics04
IMPLICIT NONE
INTEGER :: a, i, j, k, n
!ERROR: concurrent-header mask-expr references variable 'n' in LOCAL locality-spec
!ERROR: DO CONCURRENT mask expression references variable 'n' in LOCAL locality-spec
DO CONCURRENT (INTEGER *2 :: i = 1:10, i < j + n) LOCAL(n)
PRINT *, "hello"
END DO
!ERROR: concurrent-header mask-expr references variable 'a' in LOCAL locality-spec
!ERROR: DO CONCURRENT mask expression references variable 'a' in LOCAL locality-spec
DO 30 CONCURRENT (i = 1:n:1, j=1:n:2, k=1:n:3, a<3) LOCAL (a)
PRINT *, "hello"
30 END DO
! Initial expression
!ERROR: concurrent-control expression references index-name 'j'
!ERROR: DO CONCURRENT limit expression may not reference index variable 'j'
DO CONCURRENT (i = j:3, j=1:3)
END DO
! Final expression
!ERROR: concurrent-control expression references index-name 'j'
!ERROR: DO CONCURRENT limit expression may not reference index variable 'j'
DO CONCURRENT (i = 1:j, j=1:3)
END DO
! Step expression
!ERROR: concurrent-control expression references index-name 'j'
!ERROR: DO CONCURRENT step expression may not reference index variable 'j'
DO CONCURRENT (i = 1:3:j, j=1:3)
END DO
!ERROR: concurrent-control expression references index-name 'i'
!ERROR: DO CONCURRENT limit expression may not reference index variable 'i'
DO CONCURRENT (INTEGER*2 :: i = 1:3, j=i:3)
END DO

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

@ -47,7 +47,7 @@ subroutine s1()
end associate
associate (avar => ivar)
!ERROR: DO CONCURRENT step expression should not be zero
!ERROR: DO CONCURRENT step expression may not be zero
do concurrent (i = 1:2:0) default(none) shared(jvar) local(kvar)
!ERROR: Variable 'ivar' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
ivar = &

12
flang/test/semantics/dosemantics09.f90
View File

@ -18,7 +18,7 @@ subroutine s2()
end subroutine s2
subroutine s4()
!ERROR: concurrent-header expression references variable 'i' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'i' in LOCAL locality-spec
do concurrent (j=i:10) local(i)
end do
end subroutine s4
@ -36,7 +36,7 @@ subroutine s6()
end subroutine s6
subroutine s7()
!ERROR: concurrent-header expression references variable 'i' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'i' in LOCAL locality-spec
do concurrent (j=1:i) local(i)
end do
end subroutine s7
@ -54,7 +54,7 @@ subroutine s9()
end subroutine s9
subroutine s10()
!ERROR: concurrent-header expression references variable 'i' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'i' in LOCAL locality-spec
do concurrent (j=1:10:i) local(i)
end do
end subroutine s10
@ -75,7 +75,7 @@ subroutine s13()
! Test construct-association, in this case, established by the "shared"
integer :: ivar
associate (avar => ivar)
!ERROR: concurrent-header expression references variable 'ivar' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'ivar' in LOCAL locality-spec
do concurrent (j=1:10:avar) local(avar)
end do
end associate
@ -88,7 +88,7 @@ subroutine s14()
! Test use-association, in this case, established by the "shared"
use m1
!ERROR: concurrent-header expression references variable 'mvar' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'mvar' in LOCAL locality-spec
do concurrent (k=mvar:10) local(mvar)
end do
end subroutine s14
@ -98,7 +98,7 @@ subroutine s15()
! locality-spec
ivar = 3
do concurrent (j=ivar:10) shared(ivar)
!ERROR: concurrent-header expression references variable 'ivar' in LOCAL locality-spec
!ERROR: DO CONCURRENT expression references variable 'ivar' in LOCAL locality-spec
do concurrent (k=ivar:10) local(ivar)
end do
end do

52
flang/test/semantics/forall01.f90
View File

@ -1,14 +1,22 @@
subroutine forall1
real :: a(9)
!ERROR: 'i' is already declared in this scoping unit
!ERROR: Cannot redefine FORALL variable 'i'
forall (i=1:8, i=1:9) a(i) = i
!ERROR: 'i' is already declared in this scoping unit
!ERROR: Cannot redefine FORALL variable 'i'
forall (i=1:8, i=1:9)
a(i) = i
end forall
forall (j=1:8)
!ERROR: 'j' is already declared in this scoping unit
!ERROR: Cannot redefine FORALL variable 'j'
forall (j=1:9)
end forall
end forall
end
subroutine forall2
integer, pointer :: a(:)
integer, target :: b(10,10)
@ -16,8 +24,52 @@ subroutine forall2
!ERROR: Impure procedure 'f_impure' may not be referenced in a FORALL
a(f_impure(i):) => b(i,:)
end forall
!ERROR: FORALL mask expression may not reference impure procedure 'f_impure'
forall (j=1:10, f_impure(1)>2)
end forall
contains
impure integer function f_impure(i)
f_impure = i
end
end
subroutine forall3
real :: x
forall(i=1:10)
!ERROR: Cannot redefine FORALL variable 'i'
i = 1
end forall
forall(i=1:10)
forall(j=1:10)
!ERROR: Cannot redefine FORALL variable 'i'
i = 1
end forall
end forall
!ERROR: Cannot redefine FORALL variable 'i'
forall(i=1:10) i = 1
end
subroutine forall4
integer, parameter :: zero = 0
integer :: a(10)
!ERROR: FORALL limit expression may not reference index variable 'i'
forall(i=1:i)
a(i) = i
end forall
!ERROR: FORALL step expression may not reference index variable 'i'
forall(i=1:10:i)
a(i) = i
end forall
!ERROR: FORALL step expression may not be zero
forall(i=1:10:zero)
a(i) = i
end forall
!ERROR: FORALL limit expression may not reference index variable 'i'
forall(i=1:i) a(i) = i
!ERROR: FORALL step expression may not reference index variable 'i'
forall(i=1:10:i) a(i) = i
!ERROR: FORALL step expression may not be zero
forall(i=1:10:zero) a(i) = i
end

8
flang/test/semantics/resolve35.f90
View File

@ -50,14 +50,6 @@ subroutine s4
end forall
end
subroutine s5
real :: a(10), b(10)
!ERROR: 'i' is already declared in this scoping unit
forall(i=1:10, i=1:10)
a(i) = b(i)
end forall
end
subroutine s6
integer, parameter :: n = 4
real, dimension(n) :: x