[flang-commits] [flang] 1c2e5fd - [flang] Enforce constraint: defined ass't in WHERE must be elemental
peter klausler via flang-commits
flang-commits at lists.llvm.org
Mon Sep 27 10:13:03 PDT 2021
Author: peter klausler
Date: 2021-09-27T10:12:53-07:00
New Revision: 1c2e5fd66ea27d0c51360ba4e22099124a915562
URL: https://github.com/llvm/llvm-project/commit/1c2e5fd66ea27d0c51360ba4e22099124a915562
DIFF: https://github.com/llvm/llvm-project/commit/1c2e5fd66ea27d0c51360ba4e22099124a915562.diff
LOG: [flang] Enforce constraint: defined ass't in WHERE must be elemental
A defined assignment subroutine invoked in the context of a WHERE
statement or construct must necessarily be elemental (C1032).
Differential Revision: https://reviews.llvm.org/D109932
Added:
Modified:
flang/include/flang/Semantics/expression.h
flang/lib/Semantics/expression.cpp
flang/test/Semantics/assign04.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 16386cf5c16ff..26e61b440cad3 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -105,9 +105,11 @@ class ExpressionAnalyzer {
explicit ExpressionAnalyzer(semantics::SemanticsContext &sc) : context_{sc} {}
ExpressionAnalyzer(semantics::SemanticsContext &sc, FoldingContext &fc)
: context_{sc}, foldingContext_{fc} {}
- ExpressionAnalyzer(ExpressionAnalyzer &) = default;
+ ExpressionAnalyzer(const ExpressionAnalyzer &) = default;
semantics::SemanticsContext &context() const { return context_; }
+ bool inWhereBody() const { return inWhereBody_; }
+ void set_inWhereBody(bool yes = true) { inWhereBody_ = yes; }
FoldingContext &GetFoldingContext() const { return foldingContext_; }
@@ -366,6 +368,7 @@ class ExpressionAnalyzer {
std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
bool isWholeAssumedSizeArrayOk_{false};
bool useSavedTypedExprs_{true};
+ bool inWhereBody_{false};
friend class ArgumentAnalyzer;
};
@@ -402,12 +405,6 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
SemanticsContext &, common::TypeCategory,
const std::optional<parser::KindSelector> &);
-void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
-const evaluate::Assignment *AnalyzeAssignmentStmt(
- SemanticsContext &, const parser::AssignmentStmt &);
-const evaluate::Assignment *AnalyzePointerAssignmentStmt(
- SemanticsContext &, const parser::PointerAssignmentStmt &);
-
// Semantic analysis of all expressions in a parse tree, which becomes
// decorated with typed representations for top-level expressions.
class ExprChecker {
@@ -445,18 +442,38 @@ class ExprChecker {
bool Pre(const parser::DataImpliedDo &);
bool Pre(const parser::CallStmt &x) {
- AnalyzeCallStmt(context_, x);
+ exprAnalyzer_.Analyze(x);
return false;
}
bool Pre(const parser::AssignmentStmt &x) {
- AnalyzeAssignmentStmt(context_, x);
+ exprAnalyzer_.Analyze(x);
return false;
}
bool Pre(const parser::PointerAssignmentStmt &x) {
- AnalyzePointerAssignmentStmt(context_, x);
+ exprAnalyzer_.Analyze(x);
return false;
}
+ // Track whether we're in a WHERE statement or construct body
+ bool Pre(const parser::WhereStmt &) {
+ ++whereDepth_;
+ exprAnalyzer_.set_inWhereBody(InWhereBody());
+ return true;
+ }
+ void Post(const parser::WhereStmt &) {
+ --whereDepth_;
+ exprAnalyzer_.set_inWhereBody(InWhereBody());
+ }
+ bool Pre(const parser::WhereBodyConstruct &) {
+ ++whereDepth_;
+ exprAnalyzer_.set_inWhereBody(InWhereBody());
+ return true;
+ }
+ void Post(const parser::WhereBodyConstruct &) {
+ --whereDepth_;
+ exprAnalyzer_.set_inWhereBody(InWhereBody());
+ }
+
template <typename A> bool Pre(const parser::Scalar<A> &x) {
exprAnalyzer_.Analyze(x);
return false;
@@ -479,8 +496,11 @@ class ExprChecker {
}
private:
+ bool InWhereBody() const { return whereDepth_ > 0; }
+
SemanticsContext &context_;
evaluate::ExpressionAnalyzer exprAnalyzer_{context_};
+ int whereDepth_{0}; // nesting of WHERE statements & constructs
};
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_EXPRESSION_H_
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 9618535f742e1..fd372cb76bfe7 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3338,6 +3338,11 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
}
auto restorer{context_.GetContextualMessages().SetLocation(source_)};
if (std::optional<ProcedureRef> procRef{GetDefinedAssignmentProc()}) {
+ if (context_.inWhereBody() && !procRef->proc().IsElemental()) { // C1032
+ context_.Say(
+ "Defined assignment in WHERE must be elemental, but '%s' is not"_err_en_US,
+ DEREF(procRef->proc().GetSymbol()).name());
+ }
context_.CheckCall(source_, procRef->proc(), procRef->arguments());
return std::move(*procRef);
}
@@ -3627,19 +3632,6 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
return analyzer.AnalyzeKindSelector(category, selector);
}
-void AnalyzeCallStmt(SemanticsContext &context, const parser::CallStmt &call) {
- evaluate::ExpressionAnalyzer{context}.Analyze(call);
-}
-
-const evaluate::Assignment *AnalyzeAssignmentStmt(
- SemanticsContext &context, const parser::AssignmentStmt &stmt) {
- return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
-}
-const evaluate::Assignment *AnalyzePointerAssignmentStmt(
- SemanticsContext &context, const parser::PointerAssignmentStmt &stmt) {
- return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
-}
-
ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
bool ExprChecker::Pre(const parser::DataImpliedDo &ido) {
diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index daf3d54974f69..998eb98cc144a 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -172,3 +172,46 @@ subroutine sub(arg1, arg2, arg3)
local1 = local5 ! mismatched constant LEN type parameter
end subroutine sub
end subroutine s12
+
+subroutine s13()
+ interface assignment(=)
+ procedure :: cToR, cToRa, cToI
+ end interface
+ real :: x(1)
+ integer :: n(1)
+ x='0' ! fine
+ n='0' ! fine
+ !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not
+ where ([1==1]) x='*'
+ where ([1==1]) n='*' ! fine
+ forall (j=1:1)
+ where (j==1)
+ !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+ x(j)='?'
+ n(j)='?' ! fine
+ elsewhere (.false.)
+ !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+ x(j)='1'
+ n(j)='1' ! fine
+ elsewhere
+ !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+ x(j)='9'
+ n(j)='9' ! fine
+ end where
+ end forall
+ x='0' ! still fine
+ n='0' ! still fine
+ contains
+ subroutine cToR(x, c)
+ real, intent(out) :: x
+ character, intent(in) :: c
+ end subroutine
+ subroutine cToRa(x, c)
+ real, intent(out) :: x(:)
+ character, intent(in) :: c
+ end subroutine
+ elemental subroutine cToI(n, c)
+ integer, intent(out) :: n
+ character, intent(in) :: c
+ end subroutine
+end subroutine s13
More information about the flang-commits
mailing list