[flang-commits] [flang] 24e8e21 - [flang] Refine WhyNotModifiable()
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Jan 19 11:45:02 PST 2021
Author: peter klausler
Date: 2021-01-19T11:44:51-08:00
New Revision: 24e8e21f19f4380e8410a12f9135bfef3c046142
URL: https://github.com/llvm/llvm-project/commit/24e8e21f19f4380e8410a12f9135bfef3c046142
DIFF: https://github.com/llvm/llvm-project/commit/24e8e21f19f4380e8410a12f9135bfef3c046142.diff
LOG: [flang] Refine WhyNotModifiable()
The utility routine WhyNotModifiable() needed to become more
aware of the use of pointers in data-refs; the targets of
pointer components are sometimes modifiable even when the
leftmost ("base") symbol of a data-ref is not.
Added a new unit test for WhyNotModifiable() that uses internal
READ statements (mostly), since I/O semantic checking uses
WhyNotModifiable() for all its definability checking.
Differential Revision: https://reviews.llvm.org/D94849
Added:
flang/test/Semantics/modifiable01.f90
Modified:
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/tools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 69eab61f25b2..3fe3dc1843ec 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -336,6 +336,9 @@ template <typename A> const Symbol *GetFirstSymbol(const A &x) {
}
}
+// GetLastPointerSymbol(A%PTR1%B%PTR2%C) -> PTR2
+const Symbol *GetLastPointerSymbol(const evaluate::DataRef &);
+
// Creation of conversion expressions can be done to either a known
// specific intrinsic type with ConvertToType<T>(x) or by converting
// one arbitrary expression to the type of another with ConvertTo(to, from).
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index b1c01d4f4711..2b04ed8a6550 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -896,6 +896,31 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
return msg;
}
+// GetLastPointerSymbol()
+static const Symbol *GetLastPointerSymbol(const Symbol &symbol) {
+ return IsPointer(GetAssociationRoot(symbol)) ? &symbol : nullptr;
+}
+static const Symbol *GetLastPointerSymbol(const SymbolRef &symbol) {
+ return GetLastPointerSymbol(*symbol);
+}
+static const Symbol *GetLastPointerSymbol(const Component &x) {
+ const Symbol &c{x.GetLastSymbol()};
+ return IsPointer(c) ? &c : GetLastPointerSymbol(x.base());
+}
+static const Symbol *GetLastPointerSymbol(const NamedEntity &x) {
+ const auto *c{x.UnwrapComponent()};
+ return c ? GetLastPointerSymbol(*c) : GetLastPointerSymbol(x.GetLastSymbol());
+}
+static const Symbol *GetLastPointerSymbol(const ArrayRef &x) {
+ return GetLastPointerSymbol(x.base());
+}
+static const Symbol *GetLastPointerSymbol(const CoarrayRef &x) {
+ return nullptr;
+}
+const Symbol *GetLastPointerSymbol(const DataRef &x) {
+ return std::visit([](const auto &y) { return GetLastPointerSymbol(y); }, x.u);
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 9095951389f2..de19ed4d6d40 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -928,9 +928,12 @@ void IoChecker::CheckForDefinableVariable(
const A &var, const std::string &s) const {
const Symbol *sym{
GetFirstName(*parser::Unwrap<parser::Variable>(var)).symbol};
- if (WhyNotModifiable(*sym, context_.FindScope(*context_.location()))) {
- context_.Say(parser::FindSourceLocation(var),
- "%s variable '%s' must be definable"_err_en_US, s, sym->name());
+ if (auto whyNot{
+ WhyNotModifiable(*sym, context_.FindScope(*context_.location()))}) {
+ auto at{parser::FindSourceLocation(var)};
+ context_
+ .Say(at, "%s variable '%s' must be definable"_err_en_US, s, sym->name())
+ .Attach(at, std::move(*whyNot), sym->name());
}
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 1bc008610bf0..f7d3c20de2a0 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -776,27 +776,62 @@ bool InProtectedContext(const Symbol &symbol, const Scope ¤tScope) {
}
// C1101 and C1158
-std::optional<parser::MessageFixedText> WhyNotModifiable(
- const Symbol &original, const Scope &scope) {
- const Symbol &symbol{GetAssociationRoot(original)};
+// Modifiability checks on the leftmost symbol ("base object")
+// of a data-ref
+std::optional<parser::MessageFixedText> WhyNotModifiableFirst(
+ const Symbol &symbol, const Scope &scope) {
if (symbol.has<AssocEntityDetails>()) {
return "'%s' is construct associated with an expression"_en_US;
- } else if (InProtectedContext(symbol, scope)) {
- return "'%s' is protected in this scope"_en_US;
} else if (IsExternalInPureContext(symbol, scope)) {
return "'%s' is externally visible and referenced in a pure"
" procedure"_en_US;
- } else if (IsOrContainsEventOrLockComponent(symbol)) {
+ } else if (!IsVariableName(symbol)) {
+ return "'%s' is not a variable"_en_US;
+ } else {
+ return std::nullopt;
+ }
+}
+
+// Modifiability checks on the rightmost symbol of a data-ref
+std::optional<parser::MessageFixedText> WhyNotModifiableLast(
+ const Symbol &symbol, const Scope &scope) {
+ if (IsOrContainsEventOrLockComponent(symbol)) {
return "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US;
+ } else {
+ return std::nullopt;
+ }
+}
+
+// Modifiability checks on the leftmost (base) symbol of a data-ref
+// that apply only when there are no pointer components or a base
+// that is a pointer.
+std::optional<parser::MessageFixedText> WhyNotModifiableIfNoPtr(
+ const Symbol &symbol, const Scope &scope) {
+ if (InProtectedContext(symbol, scope)) {
+ return "'%s' is protected in this scope"_en_US;
} else if (IsIntentIn(symbol)) {
return "'%s' is an INTENT(IN) dummy argument"_en_US;
- } else if (!IsVariableName(symbol)) {
- return "'%s' is not a variable"_en_US;
} else {
return std::nullopt;
}
}
+// Apply all modifiability checks to a single symbol
+std::optional<parser::MessageFixedText> WhyNotModifiable(
+ const Symbol &original, const Scope &scope) {
+ const Symbol &symbol{GetAssociationRoot(original)};
+ if (auto first{WhyNotModifiableFirst(symbol, scope)}) {
+ return first;
+ } else if (auto last{WhyNotModifiableLast(symbol, scope)}) {
+ return last;
+ } else if (!IsPointer(symbol)) {
+ return WhyNotModifiableIfNoPtr(symbol, scope);
+ } else {
+ return std::nullopt;
+ }
+}
+
+// Modifiability checks for a data-ref
std::optional<parser::Message> WhyNotModifiable(parser::CharBlock at,
const SomeExpr &expr, const Scope &scope, bool vectorSubscriptIsOk) {
if (!evaluate::IsVariable(expr)) {
@@ -805,10 +840,23 @@ std::optional<parser::Message> WhyNotModifiable(parser::CharBlock at,
if (!vectorSubscriptIsOk && evaluate::HasVectorSubscript(expr)) {
return parser::Message{at, "Variable has a vector subscript"_en_US};
}
- const Symbol &symbol{dataRef->GetFirstSymbol()};
- if (auto maybeWhy{WhyNotModifiable(symbol, scope)}) {
- return parser::Message{symbol.name(),
- parser::MessageFormattedText{std::move(*maybeWhy), symbol.name()}};
+ const Symbol &first{GetAssociationRoot(dataRef->GetFirstSymbol())};
+ if (auto maybeWhyFirst{WhyNotModifiableFirst(first, scope)}) {
+ return parser::Message{first.name(),
+ parser::MessageFormattedText{
+ std::move(*maybeWhyFirst), first.name()}};
+ }
+ const Symbol &last{dataRef->GetLastSymbol()};
+ if (auto maybeWhyLast{WhyNotModifiableLast(last, scope)}) {
+ return parser::Message{last.name(),
+ parser::MessageFormattedText{std::move(*maybeWhyLast), last.name()}};
+ }
+ if (!GetLastPointerSymbol(*dataRef)) {
+ if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(first, scope)}) {
+ return parser::Message{first.name(),
+ parser::MessageFormattedText{
+ std::move(*maybeWhyFirst), first.name()}};
+ }
}
} else {
// reference to function returning POINTER
diff --git a/flang/test/Semantics/modifiable01.f90 b/flang/test/Semantics/modifiable01.f90
new file mode 100644
index 000000000000..391a643e3368
--- /dev/null
+++ b/flang/test/Semantics/modifiable01.f90
@@ -0,0 +1,70 @@
+! RUN: not %f18 -fparse-only %s 2>&1 | FileCheck %s
+! Test WhyNotModifiable() explanations
+
+module prot
+ real, protected :: prot
+ type :: ptype
+ real, pointer :: ptr
+ real :: x
+ end type
+ type(ptype), protected :: protptr
+ contains
+ subroutine ok
+ prot = 0. ! ok
+ end subroutine
+end module
+
+module m
+ use iso_fortran_env
+ use prot
+ type :: t1
+ type(lock_type) :: lock
+ end type
+ type :: t2
+ type(t1) :: x1
+ real :: x2
+ end type
+ type(t2) :: t2static
+ character(*), parameter :: internal = '0'
+ contains
+ subroutine test1(dummy)
+ real :: arr(2)
+ integer, parameter :: j3 = 666
+ type(ptype), intent(in) :: dummy
+ type(t2) :: t2var
+ associate (a => 3+4)
+ !CHECK: error: Input variable 'a' must be definable
+ !CHECK: 'a' is construct associated with an expression
+ read(internal,*) a
+ end associate
+ associate (a => arr([1])) ! vector subscript
+ !CHECK: error: Input variable 'a' must be definable
+ !CHECK: 'a' is construct associated with an expression
+ read(internal,*) a
+ end associate
+ associate (a => arr(2:1:-1))
+ read(internal,*) a ! ok
+ end associate
+ !CHECK: error: Input variable 'j3' must be definable
+ !CHECK: 'j3' is not a variable
+ read(internal,*) j3
+ !CHECK: error: Left-hand side of assignment is not modifiable
+ !CHECK: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
+ t2var = t2static
+ t2var%x2 = 0. ! ok
+ !CHECK: error: Left-hand side of assignment is not modifiable
+ !CHECK: 'prot' is protected in this scope
+ prot = 0.
+ protptr%ptr = 0. ! ok
+ !CHECK: error: Left-hand side of assignment is not modifiable
+ !CHECK: 'dummy' is an INTENT(IN) dummy argument
+ dummy%x = 0.
+ dummy%ptr = 0. ! ok
+ end subroutine
+ pure subroutine test2(ptr)
+ integer, pointer, intent(in) :: ptr
+ !CHECK: error: Input variable 'ptr' must be definable
+ !CHECK: 'ptr' is externally visible and referenced in a pure procedure
+ read(internal,*) ptr
+ end subroutine
+end module
More information about the flang-commits
mailing list