[flang-commits] [flang] 34a4eef - [flang] Warn about impure calls in concurrent headers (#108436)
via flang-commits
flang-commits at lists.llvm.org
Mon Sep 16 13:44:44 PDT 2024
Author: Peter Klausler
Date: 2024-09-16T13:44:41-07:00
New Revision: 34a4eefcbd8d394616cdb16dcadc70b934a577ce
URL: https://github.com/llvm/llvm-project/commit/34a4eefcbd8d394616cdb16dcadc70b934a577ce
DIFF: https://github.com/llvm/llvm-project/commit/34a4eefcbd8d394616cdb16dcadc70b934a577ce.diff
LOG: [flang] Warn about impure calls in concurrent headers (#108436)
Emit a warning when an impure function is referenced from a DO
CONCURRENT or FORALL concurrent-header that is not nested within another
such construct. (That nested case is already an error.)
Added:
Modified:
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/check-do-forall.h
flang/test/Semantics/OpenMP/workshare02.f90
flang/test/Semantics/call11.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index d798244ff1ef2d..b9778e96080a62 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -122,6 +122,10 @@ class DoConcurrentBodyEnforce {
}
return true;
}
+ bool Pre(const parser::ConcurrentHeader &) {
+ // handled in CheckConcurrentHeader
+ return false;
+ }
template <typename T> void Post(const T &) {}
// C1140 -- Can't deallocate a polymorphic entity in a DO CONCURRENT.
@@ -375,8 +379,13 @@ class DoConcurrentVariableEnforce {
// Find a DO or FORALL and enforce semantics checks on its body
class DoContext {
public:
- DoContext(SemanticsContext &context, IndexVarKind kind, bool isNested)
- : context_{context}, kind_{kind}, isNested_{isNested} {}
+ DoContext(SemanticsContext &context, IndexVarKind kind,
+ const std::list<IndexVarKind> nesting)
+ : context_{context}, kind_{kind} {
+ if (!nesting.empty()) {
+ concurrentNesting_ = nesting.back();
+ }
+ }
// 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
@@ -439,8 +448,8 @@ class DoContext {
common::visitors{[&](const auto &x) { return GetAssignment(x); }},
stmt.u)}) {
CheckForallIndexesUsed(*assignment);
- CheckForImpureCall(assignment->lhs);
- CheckForImpureCall(assignment->rhs);
+ CheckForImpureCall(assignment->lhs, kind_);
+ CheckForImpureCall(assignment->rhs, kind_);
if (IsVariable(assignment->lhs)) {
if (const Symbol * symbol{GetLastSymbol(assignment->lhs)}) {
@@ -455,23 +464,23 @@ class DoContext {
if (const auto *proc{
std::get_if<evaluate::ProcedureRef>(&assignment->u)}) {
- CheckForImpureCall(*proc);
+ CheckForImpureCall(*proc, kind_);
}
common::visit(
common::visitors{
[](const evaluate::Assignment::Intrinsic &) {},
[&](const evaluate::ProcedureRef &proc) {
- CheckForImpureCall(proc);
+ CheckForImpureCall(proc, kind_);
},
[&](const evaluate::Assignment::BoundsSpec &bounds) {
for (const auto &bound : bounds) {
- CheckForImpureCall(SomeExpr{bound});
+ CheckForImpureCall(SomeExpr{bound}, kind_);
}
},
[&](const evaluate::Assignment::BoundsRemapping &bounds) {
for (const auto &bound : bounds) {
- CheckForImpureCall(SomeExpr{bound.first});
- CheckForImpureCall(SomeExpr{bound.second});
+ CheckForImpureCall(SomeExpr{bound.first}, kind_);
+ CheckForImpureCall(SomeExpr{bound.second}, kind_);
}
},
},
@@ -754,12 +763,10 @@ class DoContext {
if (indexName.symbol) {
indexNames.insert(*indexName.symbol);
}
- if (isNested_) {
- CheckForImpureCall(std::get<1>(control.t));
- CheckForImpureCall(std::get<2>(control.t));
- if (const auto &stride{std::get<3>(control.t)}) {
- CheckForImpureCall(*stride);
- }
+ CheckForImpureCall(std::get<1>(control.t), concurrentNesting_);
+ CheckForImpureCall(std::get<2>(control.t), concurrentNesting_);
+ if (const auto &stride{std::get<3>(control.t)}) {
+ CheckForImpureCall(*stride, concurrentNesting_);
}
}
if (!indexNames.empty()) {
@@ -819,20 +826,29 @@ class DoContext {
CheckConcurrentHeader(std::get<parser::ConcurrentHeader>(concurrent.t));
}
- template <typename T> void CheckForImpureCall(const T &x) const {
+ template <typename T>
+ void CheckForImpureCall(
+ const T &x, std::optional<IndexVarKind> nesting) const {
if (auto bad{FindImpureCall(context_.foldingContext(), x)}) {
- context_.Say(
- "Impure procedure '%s' may not be referenced in a %s"_err_en_US, *bad,
- LoopKindName());
+ if (nesting) {
+ context_.Say(
+ "Impure procedure '%s' may not be referenced in a %s"_err_en_US,
+ *bad, LoopKindName(*nesting));
+ } else {
+ context_.Say(
+ "Impure procedure '%s' should not be referenced in a %s header"_warn_en_US,
+ *bad, LoopKindName(kind_));
+ }
}
}
- void CheckForImpureCall(const parser::ScalarIntExpr &x) const {
+ void CheckForImpureCall(const parser::ScalarIntExpr &x,
+ std::optional<IndexVarKind> nesting) const {
const auto &parsedExpr{x.thing.thing.value()};
auto oldLocation{context_.location()};
context_.set_location(parsedExpr.source);
if (const auto &typedExpr{parsedExpr.typedExpr}) {
if (const auto &expr{typedExpr->v}) {
- CheckForImpureCall(*expr);
+ CheckForImpureCall(*expr, nesting);
}
}
context_.set_location(oldLocation);
@@ -885,54 +901,59 @@ class DoContext {
}
// For messages where the DO loop must be DO CONCURRENT, make that explicit.
- const char *LoopKindName() const {
- return kind_ == IndexVarKind::DO ? "DO CONCURRENT" : "FORALL";
+ const char *LoopKindName(IndexVarKind kind) const {
+ return kind == IndexVarKind::DO ? "DO CONCURRENT" : "FORALL";
}
+ const char *LoopKindName() const { return LoopKindName(kind_); }
SemanticsContext &context_;
const IndexVarKind kind_;
parser::CharBlock currentStatementSourcePosition_;
- bool isNested_{false};
+ std::optional<IndexVarKind> concurrentNesting_;
}; // class DoContext
void DoForallChecker::Enter(const parser::DoConstruct &doConstruct) {
- DoContext doContext{context_, IndexVarKind::DO, constructNesting_ > 0};
+ DoContext doContext{context_, IndexVarKind::DO, nestedWithinConcurrent_};
+ if (doConstruct.IsDoConcurrent()) {
+ nestedWithinConcurrent_.push_back(IndexVarKind::DO);
+ }
doContext.DefineDoVariables(doConstruct);
+ doContext.Check(doConstruct);
}
void DoForallChecker::Leave(const parser::DoConstruct &doConstruct) {
- DoContext doContext{context_, IndexVarKind::DO, constructNesting_ > 0};
- ++constructNesting_;
- doContext.Check(doConstruct);
+ DoContext doContext{context_, IndexVarKind::DO, nestedWithinConcurrent_};
doContext.ResetDoVariables(doConstruct);
- --constructNesting_;
+ if (doConstruct.IsDoConcurrent()) {
+ nestedWithinConcurrent_.pop_back();
+ }
}
void DoForallChecker::Enter(const parser::ForallConstruct &construct) {
- DoContext doContext{context_, IndexVarKind::FORALL, constructNesting_ > 0};
+ DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};
doContext.ActivateIndexVars(GetControls(construct));
- ++constructNesting_;
+ nestedWithinConcurrent_.push_back(IndexVarKind::FORALL);
doContext.Check(construct);
}
void DoForallChecker::Leave(const parser::ForallConstruct &construct) {
- DoContext doContext{context_, IndexVarKind::FORALL, constructNesting_ > 0};
+ DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};
doContext.DeactivateIndexVars(GetControls(construct));
- --constructNesting_;
+ nestedWithinConcurrent_.pop_back();
}
void DoForallChecker::Enter(const parser::ForallStmt &stmt) {
- DoContext doContext{context_, IndexVarKind::FORALL, constructNesting_ > 0};
- ++constructNesting_;
+ DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};
+ nestedWithinConcurrent_.push_back(IndexVarKind::FORALL);
doContext.Check(stmt);
doContext.ActivateIndexVars(GetControls(stmt));
}
void DoForallChecker::Leave(const parser::ForallStmt &stmt) {
- DoContext doContext{context_, IndexVarKind::FORALL, constructNesting_ > 0};
+ DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};
doContext.DeactivateIndexVars(GetControls(stmt));
- --constructNesting_;
+ nestedWithinConcurrent_.pop_back();
}
void DoForallChecker::Leave(const parser::ForallAssignmentStmt &stmt) {
- DoContext doContext{context_, IndexVarKind::FORALL, constructNesting_ > 0};
+ DoContext doContext{context_, IndexVarKind::FORALL, nestedWithinConcurrent_};
doContext.Check(stmt);
}
diff --git a/flang/lib/Semantics/check-do-forall.h b/flang/lib/Semantics/check-do-forall.h
index f08ff3467d4cc9..4a65818364d764 100644
--- a/flang/lib/Semantics/check-do-forall.h
+++ b/flang/lib/Semantics/check-do-forall.h
@@ -60,7 +60,7 @@ class DoForallChecker : public virtual BaseChecker {
private:
SemanticsContext &context_;
int exprDepth_{0};
- int constructNesting_{0};
+ std::list<SemanticsContext::IndexVarKind> nestedWithinConcurrent_;
void SayBadLeave(
StmtType, const char *enclosingStmt, const ConstructNode &) const;
diff --git a/flang/test/Semantics/OpenMP/workshare02.f90 b/flang/test/Semantics/OpenMP/workshare02.f90
index e099ecb9f1e614..11f33d63a3eb80 100644
--- a/flang/test/Semantics/OpenMP/workshare02.f90
+++ b/flang/test/Semantics/OpenMP/workshare02.f90
@@ -40,6 +40,7 @@ subroutine workshare(aa, bb, cc, dd, ee, ff, n)
cc = ee + my_func()
end where
+ !WARNING: Impure procedure 'my_func' should not be referenced in a FORALL header
!ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKSHARE construct
forall (j = 1:my_func()) aa(j) = aa(j) + bb(j)
diff --git a/flang/test/Semantics/call11.f90 b/flang/test/Semantics/call11.f90
index 7bc4931890dee5..5358c741e2998e 100644
--- a/flang/test/Semantics/call11.f90
+++ b/flang/test/Semantics/call11.f90
@@ -42,30 +42,36 @@ subroutine test
!ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
a(j) = impure(j) ! C1139
end do
- do concurrent (k=impure(1):1); end do ! ok
- do concurrent (k=1:impure(1)); end do ! ok
- do concurrent (k=1:1:impure(1)); end do ! ok
- forall (k=impure(1):1); end forall ! ok
- forall (k=1:impure(1)); end forall ! ok
- forall (k=1:1:impure(1)); end forall ! ok
+ !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header
+ do concurrent (k=impure(1):1); end do
+ !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header
+ do concurrent (k=1:impure(1)); end do
+ !WARNING: Impure procedure 'impure' should not be referenced in a DO CONCURRENT header
+ do concurrent (k=1:1:impure(1)); end do
+ !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header
+ forall (k=impure(1):1); end forall
+ !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header
+ forall (k=1:impure(1)); end forall
+ !WARNING: Impure procedure 'impure' should not be referenced in a FORALL header
+ forall (k=1:1:impure(1)); end forall
do concurrent (j=1:1)
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
do concurrent (k=impure(1):1); end do
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
do concurrent (k=1:impure(1)); end do
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
do concurrent (k=1:1:impure(1)); end do
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=impure(1):1); end forall
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=1:impure(1)); end forall
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=1:1:impure(1)); end forall
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=impure(1):1) a(k) = 0.
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=1:impure(1)) a(k) = 0.
- !ERROR: Impure procedure 'impure' may not be referenced in DO CONCURRENT
+ !ERROR: Impure procedure 'impure' may not be referenced in a DO CONCURRENT
forall (k=1:1:impure(1)) a(k) = 0.
end do
forall (j=1:1)
More information about the flang-commits
mailing list