From a0a1f519c0abc99ecffd4aaa997a4bb01f63cf3e Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Thu, 5 Mar 2020 17:55:51 -0800 Subject: [PATCH] [flang] Perform definability checks on LHS of assignment If the pure context check succeeds, call `WhyNotModifiable` to verify the LHS can be modified. Detect assignment to whole assumed-size array. Change `IsVariable` to return false for a parameter or a component or array reference whose base it a parameter. When analyzing an assignment statement, report an error if the LHS is a constant expression. Otherwise it might get folded and when we detect the problem later the error will be confusing. Handle Substring on LHS of assignment. Change ExtractDataRef and IsVariable to work on a Substring. Fix IsImpliedShape and IsAssumedSize predicates in ArraySpec. Fix C709 check in check-declarations.cpp. Original-commit: flang-compiler/f18@f2d2657aab051b938ec4e4702926aadb436c19aa Reviewed-on: https://github.com/flang-compiler/f18/pull/1050 --- flang/include/flang/Evaluate/tools.h | 11 ++- flang/lib/Evaluate/tools.cpp | 25 +++++ flang/lib/Semantics/assignment.cpp | 18 +++- flang/lib/Semantics/check-declarations.cpp | 8 +- flang/lib/Semantics/expression.cpp | 12 ++- flang/lib/Semantics/type.cpp | 8 +- flang/test/Semantics/CMakeLists.txt | 1 + flang/test/Semantics/assign04.f90 | 110 +++++++++++++++++++++ flang/test/Semantics/resolve72.f90 | 2 +- 9 files changed, 178 insertions(+), 17 deletions(-) create mode 100644 flang/test/Semantics/assign04.f90 diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 7f867813b2bc..2d2a46fc3eb1 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -64,9 +64,10 @@ struct IsVariableHelper IsVariableHelper() : Base{*this} {} using Base::operator(); Result operator()(const StaticDataObject &) const { return false; } - Result operator()(const Symbol &) const { return true; } - Result operator()(const Component &) const { return true; } - Result operator()(const ArrayRef &) const { return true; } + Result operator()(const Symbol &) const; + Result operator()(const Component &) const; + Result operator()(const ArrayRef &) const; + Result operator()(const Substring &) const; Result operator()(const CoarrayRef &) const { return true; } Result operator()(const ComplexPart &) const { return true; } Result operator()(const ProcedureDesignator &) const; @@ -218,6 +219,9 @@ std::optional ExtractDataRef(const Designator &d) { if constexpr (common::HasMember) { return DataRef{x}; } + if constexpr (std::is_same_v, Substring>) { + return ExtractDataRef(x); + } return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning }, d.u); @@ -234,6 +238,7 @@ std::optional ExtractDataRef(const std::optional &x) { return std::nullopt; } } +std::optional ExtractDataRef(const Substring &); // Predicate: is an expression is an array element reference? template bool IsArrayElement(const Expr &expr) { diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 624fb352a59e..e9e2c4f0bd5c 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -11,6 +11,7 @@ #include "flang/Evaluate/characteristics.h" #include "flang/Evaluate/traverse.h" #include "flang/Parser/message.h" +#include "flang/Semantics/tools.h" #include #include @@ -37,7 +38,31 @@ Expr Parenthesize(Expr &&expr) { std::move(expr.u)); } +std::optional ExtractDataRef(const Substring &substring) { + return std::visit( + common::visitors{ + [&](const DataRef &x) -> std::optional { return x; }, + [&](const StaticDataObject::Pointer &) -> std::optional { + return std::nullopt; + }, + }, + substring.parent()); +} + // IsVariable() + +auto IsVariableHelper::operator()(const Symbol &symbol) const -> Result { + return !symbol.attrs().test(semantics::Attr::PARAMETER); +} +auto IsVariableHelper::operator()(const Component &x) const -> Result { + return (*this)(x.base()); +} +auto IsVariableHelper::operator()(const ArrayRef &x) const -> Result { + return (*this)(x.base()); +} +auto IsVariableHelper::operator()(const Substring &x) const -> Result { + return (*this)(x.GetBaseObject()); +} auto IsVariableHelper::operator()(const ProcedureDesignator &x) const -> Result { const Symbol *symbol{x.GetSymbol()}; diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp index b309433e68f8..bd8fe2cf0311 100644 --- a/flang/lib/Semantics/assignment.cpp +++ b/flang/lib/Semantics/assignment.cpp @@ -66,10 +66,23 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) { const SomeExpr &rhs{assignment->rhs}; auto lhsLoc{std::get(stmt.t).GetSource()}; auto rhsLoc{std::get(stmt.t).source}; + auto shape{evaluate::GetShape(foldingContext(), lhs)}; + if (shape && !shape->empty() && !shape->back().has_value()) { // C1014 + Say(lhsLoc, + "Left-hand side of assignment may not be a whole assumed-size array"_err_en_US); + } + if (CheckForPureContext(lhs, rhs, rhsLoc, false)) { + const Scope &scope{context_.FindScope(lhsLoc)}; + if (auto whyNot{WhyNotModifiable(lhsLoc, lhs, scope)}) { + if (auto *msg{Say(lhsLoc, + "Left-hand side of assignment is not modifiable"_err_en_US)}) { + msg->Attach(*whyNot); + } + } + } if (whereDepth_ > 0) { CheckShape(lhsLoc, &lhs); } - CheckForPureContext(lhs, rhs, rhsLoc, false); } } @@ -169,7 +182,8 @@ bool AssignmentContext::CheckForPureContext(const SomeExpr &lhs, // ASSOCIATE(a=>x) -- check x, not a, for "a=..." base = dataRef ? &dataRef->GetFirstSymbol() : nullptr; } - if (!CheckDefinabilityInPureScope(messages, *base, scope, *pure)) { + if (base && + !CheckDefinabilityInPureScope(messages, *base, scope, *pure)) { return false; } } diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 1b7dd988e5b1..63d36e342cdb 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -333,10 +333,10 @@ void CheckHelper::CheckAssumedTypeEntity( // C709 "Assumed-type argument '%s' cannot be a coarray"_err_en_US, symbol.name()); } - if (details.IsArray() && - !(details.IsAssumedShape() || details.IsAssumedSize())) { - messages_.Say("Assumed-type argument '%s' must be assumed shape" - " or assumed size array"_err_en_US, + if (details.IsArray() && details.shape().IsExplicitShape()) { + messages_.Say( + "Assumed-type array argument 'arg8' must be assumed shape," + " assumed size, or assumed rank"_err_en_US, symbol.name()); } } diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index dd016f9433d3..302ef7fdcaf8 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -2588,10 +2588,16 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef( void ArgumentAnalyzer::Analyze(const parser::Variable &x) { source_.ExtendToCover(x.GetSource()); if (MaybeExpr expr{context_.Analyze(x)}) { - actuals_.emplace_back(std::move(*expr)); - } else { - fatalErrors_ = true; + if (!IsConstantExpr(*expr)) { + actuals_.emplace_back(std::move(*expr)); + return; + } + const Symbol *symbol{GetFirstSymbol(*expr)}; + context_.Say(x.GetSource(), + "Assignment to constant '%s' is not allowed"_err_en_US, + symbol ? symbol->name() : x.GetSource()); } + fatalErrors_ = true; } void ArgumentAnalyzer::Analyze( diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 47158c7af4ab..49bd618e3637 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -353,13 +353,13 @@ bool ArraySpec::IsDeferredShape() const { }); } bool ArraySpec::IsImpliedShape() const { - return CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); + return !IsAssumedRank() && + CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); } bool ArraySpec::IsAssumedSize() const { - return !empty() && + return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && std::all_of(begin(), end() - 1, - [](const ShapeSpec &x) { return x.ubound().isExplicit(); }) && - back().ubound().isAssumed(); + [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); } bool ArraySpec::IsAssumedRank() const { return Rank() == 1 && front().lbound().isAssumed(); diff --git a/flang/test/Semantics/CMakeLists.txt b/flang/test/Semantics/CMakeLists.txt index 7144ff9cffd1..7c826d82b961 100644 --- a/flang/test/Semantics/CMakeLists.txt +++ b/flang/test/Semantics/CMakeLists.txt @@ -115,6 +115,7 @@ set(ERROR_TESTS assign01.f90 assign02.f90 assign03.f90 + assign04.f90 if_arith02.f90 if_arith03.f90 if_arith04.f90 diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90 new file mode 100644 index 000000000000..e0a02160cba5 --- /dev/null +++ b/flang/test/Semantics/assign04.f90 @@ -0,0 +1,110 @@ +! 9.4.5 +subroutine s1 + type :: t(k, l) + integer, kind :: k + integer, len :: l + end type + type(t(1, 2)) :: x + !ERROR: Assignment to constant 'x%k' is not allowed + x%k = 4 + !ERROR: Left-hand side of assignment is not modifiable + x%l = 3 +end + +! C901 +subroutine s2(x) + real, parameter :: x = 0.0 + real, parameter :: a(*) = [1, 2, 3] + character, parameter :: c(2) = "ab" + integer :: i + !ERROR: Assignment to constant 'x' is not allowed + x = 2.0 + i = 2 + !ERROR: Left-hand side of assignment is not modifiable + a(i) = 3.0 + !ERROR: Left-hand side of assignment is not modifiable + a(i:i+1) = [4, 5] + !ERROR: Left-hand side of assignment is not modifiable + c(i:2) = "cd" +end + +! C901 +subroutine s3 + type :: t + integer :: a(2) + integer :: b + end type + type(t) :: x + type(t), parameter :: y = t([1,2], 3) + integer :: i = 1 + x%a(i) = 1 + !ERROR: Left-hand side of assignment is not modifiable + y%a(i) = 2 + x%b = 4 + !ERROR: Left-hand side of assignment is not modifiable + y%b = 5 +end + +! C844 +subroutine s4 + type :: t + integer :: a(2) + end type +contains + subroutine s(x, c) + type(t), intent(in) :: x + character(10), intent(in) :: c + type(t) :: y + !ERROR: Left-hand side of assignment is not modifiable + x = y + !ERROR: Left-hand side of assignment is not modifiable + x%a(1) = 2 + !ERROR: Left-hand side of assignment is not modifiable + c(2:3) = "ab" + end +end + +! 8.5.15(2) +module m5 + real :: x + real, protected :: y + real, private :: z + type :: t + real :: a + end type + type(t), protected :: b +end +subroutine s5() + use m5 + implicit none + x = 1.0 + !ERROR: Left-hand side of assignment is not modifiable + y = 2.0 + !ERROR: No explicit type declared for 'z' + z = 3.0 + !ERROR: Left-hand side of assignment is not modifiable + b%a = 1.0 +end + +subroutine s6(x) + integer :: x(*) + x(1:3) = [1, 2, 3] + x(:3) = [1, 2, 3] + !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value + x(:) = [1, 2, 3] + !ERROR: Left-hand side of assignment may not be a whole assumed-size array + x = [1, 2, 3] +end + +module m7 + type :: t + integer :: i + end type +contains + subroutine s7(x) + type(t) :: x(*) + x(:3)%i = [1, 2, 3] + !ERROR: Left-hand side of assignment may not be a whole assumed-size array + x%i = [1, 2, 3] + end +end diff --git a/flang/test/Semantics/resolve72.f90 b/flang/test/Semantics/resolve72.f90 index fdead88c8fe8..6ff2603b2129 100644 --- a/flang/test/Semantics/resolve72.f90 +++ b/flang/test/Semantics/resolve72.f90 @@ -19,7 +19,7 @@ subroutine s() type(*), pointer :: arg6 !ERROR: Assumed-type argument 'arg7' cannot have the VALUE attribute type(*), value :: arg7 - !ERROR: Assumed-type argument 'arg8' must be assumed shape or assumed size array + !ERROR: Assumed-type array argument 'arg8' must be assumed shape, assumed size, or assumed rank type(*), dimension(3) :: arg8 end subroutine inner1 end subroutine s