[flang-commits] [flang] 573fc61 - [flang] Fix pointer definition semantic checking via refactoring
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Oct 31 12:02:42 PDT 2022
Author: Peter Klausler
Date: 2022-10-31T12:02:21-07:00
New Revision: 573fc6187b82290665ed7d94aa50641d06260a9e
URL: https://github.com/llvm/llvm-project/commit/573fc6187b82290665ed7d94aa50641d06260a9e
DIFF: https://github.com/llvm/llvm-project/commit/573fc6187b82290665ed7d94aa50641d06260a9e.diff
LOG: [flang] Fix pointer definition semantic checking via refactoring
The infrastructure in semantics that is used to check that the
left-hand sides of normal assignment statements are really definable
variables was not being used to check whether the LHSs of pointer assignments
are modifiable, and so most cases of unmodifiable pointers are left
undiagnosed. Rework the semantics checking for pointer assignments,
NULLIFY statements, pointer dummy arguments, &c. so that cases of
unmodifiable pointers are properly caught. This has been done
by extracting all the various definability checking code that has
been implemented for different contexts in Fortran into one new
facility.
The new consolidated definability checking code returns messages
meant to be attached as "because: " explanations to context-dependent
errors like "left-hand side of assignment is not definable".
These new error message texts and their attached explanations
affect many existing tests, which have been updated. The testing
infrastructure was extended by another patch to properly compare
warnings and explanatory messages, which had been ignored until
recently.
Differential Revision: https://reviews.llvm.org/D136979
Added:
flang/lib/Semantics/definable.cpp
flang/lib/Semantics/definable.h
Modified:
flang/docs/Parsing.md
flang/include/flang/Parser/message.h
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/CMakeLists.txt
flang/lib/Semantics/assignment.cpp
flang/lib/Semantics/assignment.h
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/check-nullify.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/lib/Semantics/pointer-assignment.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/OpenMP/omp-lastprivate01.f90
flang/test/Semantics/OpenMP/omp-reduction04.f90
flang/test/Semantics/assign02.f90
flang/test/Semantics/assign03.f90
flang/test/Semantics/assign04.f90
flang/test/Semantics/atomic02.f90
flang/test/Semantics/atomic03.f90
flang/test/Semantics/atomic04.f90
flang/test/Semantics/atomic05.f90
flang/test/Semantics/atomic06.f90
flang/test/Semantics/atomic07.f90
flang/test/Semantics/atomic08.f90
flang/test/Semantics/atomic10.f90
flang/test/Semantics/call03.f90
flang/test/Semantics/call06.f90
flang/test/Semantics/call10.f90
flang/test/Semantics/call12.f90
flang/test/Semantics/collectives01.f90
flang/test/Semantics/collectives02.f90
flang/test/Semantics/collectives03.f90
flang/test/Semantics/collectives04.f90
flang/test/Semantics/deallocate05.f90
flang/test/Semantics/io01.f90
flang/test/Semantics/io02.f90
flang/test/Semantics/io03.f90
flang/test/Semantics/io04.f90
flang/test/Semantics/io05.f90
flang/test/Semantics/io06.f90
flang/test/Semantics/modifiable01.f90
flang/test/Semantics/nullify02.f90
flang/test/Semantics/random-seed.f90
flang/test/Semantics/resolve35.f90
flang/test/Semantics/resolve57.f90
flang/test/Semantics/resolve62.f90
flang/test/Semantics/resolve76.f90
flang/test/Semantics/selecttype03.f90
Removed:
################################################################################
diff --git a/flang/docs/Parsing.md b/flang/docs/Parsing.md
index 172a13946601e..e960c33dcbf34 100644
--- a/flang/docs/Parsing.md
+++ b/flang/docs/Parsing.md
@@ -134,8 +134,9 @@ indicators within the parser and in the parse tree.
Message texts, and snprintf-like formatting strings for constructing
messages, are instantiated in the various components of the parser with
C++ user defined character literals tagged with `_err_en_US`, `_warn_en_US`,
-`port_en_US`, and `_en_US` to signify severity and language; the default
-language is the dialect of English used in the United States.
+`port_en_US`, `because_en_US`, `todo_en_US`, and `_en_US` to signify severity
+and language.
+The default language is the dialect of English used in the United States.
All "fatal" errors that do not immediately abort compilation but do
prevent the generation of binary and module files are `_err_en_US`.
@@ -143,8 +144,9 @@ Warnings about detected flaws in the program that probably indicate
problems worth attention are `_warn_en_US`.
Non-conforming extensions, legacy features, and obsolescent or deleted
features will raise `_port_en_US` messages when those are enabled.
-Other messages have a simple `_en_US` suffix, including all messages
-that are explanatory attachments.
+Messages that are explanatory attachments to others are `_because_en_US`.
+Messages signifying an incomplete compiler feature are `_todo_en_US`.
+Other messages have a simple `_en_US` suffix.
As described above, messages are associated with
source code positions by means of provenance values.
diff --git a/flang/include/flang/Parser/message.h b/flang/include/flang/Parser/message.h
index 017d141a41ba5..5ff5b98dba840 100644
--- a/flang/include/flang/Parser/message.h
+++ b/flang/include/flang/Parser/message.h
@@ -29,9 +29,9 @@
namespace Fortran::parser {
-// Use "..."_err_en_US, "..."_warn_en_US, "..."_port_en_US, and "..."_en_US
-// string literals to define the static text and fatality of a message.
-//
+// Use "..."_err_en_US, "..."_warn_en_US, "..."_port_en_US, "..."_because_en_US,
+// "..."_todo_en_US, and "..."_en_US string literals to define the static text
+// and severity of a message or attachment.
enum class Severity {
Error, // fatal error that prevents code and module file generation
Warning, // likely problem
@@ -81,6 +81,10 @@ constexpr MessageFixedText operator""_port_en_US(
const char str[], std::size_t n) {
return MessageFixedText{str, n, Severity::Portability};
}
+constexpr MessageFixedText operator""_because_en_US(
+ const char str[], std::size_t n) {
+ return MessageFixedText{str, n, Severity::Because};
+}
constexpr MessageFixedText operator""_todo_en_US(
const char str[], std::size_t n) {
return MessageFixedText{str, n, Severity::Todo};
@@ -343,6 +347,17 @@ class ContextualMessages {
return Say(at_, std::forward<A>(args)...);
}
+ Message *Say(Message &&msg) {
+ if (messages_ != nullptr) {
+ if (contextMessage_) {
+ msg.SetContext(contextMessage_.get());
+ }
+ return &messages_->Say(std::move(msg));
+ } else {
+ return nullptr;
+ }
+ }
+
private:
CharBlock at_;
Messages *messages_{nullptr};
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index c4979660b845b..c1d58fa2c58f9 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -177,11 +177,6 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
bool IsAssumedLengthCharacter(const Symbol &);
bool IsExternal(const Symbol &);
bool IsModuleProcedure(const Symbol &);
-// Is the symbol modifiable in this scope
-std::optional<parser::Message> WhyNotModifiable(const Symbol &, const Scope &);
-std::optional<parser::Message> WhyNotModifiable(SourceName, const SomeExpr &,
- const Scope &, bool vectorSubscriptIsOk = false);
-const Symbol *IsExternalInPureContext(const Symbol &, const Scope &);
bool HasCoarray(const parser::Expr &);
bool IsAssumedType(const Symbol &);
bool IsPolymorphic(const Symbol &);
@@ -221,7 +216,8 @@ const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
// Determines whether an object might be visible outside a
// pure function (C1594); returns a non-null Symbol pointer for
// diagnostic purposes if so.
-const Symbol *FindExternallyVisibleObject(const Symbol &, const Scope &);
+const Symbol *FindExternallyVisibleObject(
+ const Symbol &, const Scope &, bool isPointerDefinition);
template <typename A>
const Symbol *FindExternallyVisibleObject(const A &, const Scope &) {
@@ -232,7 +228,7 @@ template <typename T>
const Symbol *FindExternallyVisibleObject(
const evaluate::Designator<T> &designator, const Scope &scope) {
if (const Symbol * symbol{designator.GetBaseObject().symbol()}) {
- return FindExternallyVisibleObject(*symbol, scope);
+ return FindExternallyVisibleObject(*symbol, scope, false);
} else if (std::holds_alternative<evaluate::CoarrayRef>(designator.u)) {
// Coindexed values are visible even if their image-local objects are not.
return designator.GetBaseObject().symbol();
diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt
index 9e7c07b9c55fa..54d4787c958a9 100644
--- a/flang/lib/Semantics/CMakeLists.txt
+++ b/flang/lib/Semantics/CMakeLists.txt
@@ -26,6 +26,7 @@ add_flang_library(FortranSemantics
check-stop.cpp
compute-offsets.cpp
data-to-inits.cpp
+ definable.cpp
expression.cpp
mod-file.cpp
pointer-assignment.cpp
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index ece504ce6b1c2..8df6991787d0d 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "assignment.h"
+#include "definable.h"
#include "pointer-assignment.h"
#include "flang/Common/idioms.h"
#include "flang/Common/restorer.h"
@@ -43,8 +44,8 @@ class AssignmentContext {
void Analyze(const parser::ConcurrentControl &);
private:
- bool CheckForPureContext(const SomeExpr &lhs, const SomeExpr &rhs,
- parser::CharBlock rhsSource, bool isPointerAssignment);
+ bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource,
+ bool isPointerAssignment);
void CheckShape(parser::CharBlock, const SomeExpr *);
template <typename... A>
parser::Message *Say(parser::CharBlock at, A &&...args) {
@@ -65,16 +66,16 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
const SomeExpr &lhs{assignment->lhs};
const SomeExpr &rhs{assignment->rhs};
auto lhsLoc{std::get<parser::Variable>(stmt.t).GetSource()};
- auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
- if (CheckForPureContext(lhs, rhs, rhsLoc, false)) {
- const Scope &scope{context_.FindScope(lhsLoc)};
- if (auto whyNot{WhyNotModifiable(lhsLoc, lhs, scope, true)}) {
- if (auto *msg{Say(lhsLoc,
- "Left-hand side of assignment is not modifiable"_err_en_US)}) {
- msg->Attach(*whyNot);
- }
+ const Scope &scope{context_.FindScope(lhsLoc)};
+ if (auto whyNot{WhyNotDefinable(lhsLoc, scope,
+ DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, lhs)}) {
+ if (auto *msg{Say(lhsLoc,
+ "Left-hand side of assignment is not definable"_err_en_US)}) {
+ msg->Attach(std::move(*whyNot));
}
}
+ auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
+ CheckForPureContext(rhs, rhsLoc, false);
if (whereDepth_ > 0) {
CheckShape(lhsLoc, &lhs);
}
@@ -84,52 +85,13 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
CHECK(whereDepth_ == 0);
if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
- const SomeExpr &lhs{assignment->lhs};
const SomeExpr &rhs{assignment->rhs};
- CheckForPureContext(lhs, rhs, std::get<parser::Expr>(stmt.t).source, true);
- auto restorer{
- foldingContext().messages().SetLocation(context_.location().value())};
- CheckPointerAssignment(foldingContext(), *assignment);
- }
-}
-
-// C1594 checks
-static bool IsPointerDummyOfPureFunction(const Symbol &x) {
- return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
- x.owner().symbol() && IsFunction(*x.owner().symbol());
-}
-
-static const char *WhyBaseObjectIsSuspicious(
- const Symbol &x, const Scope &scope) {
- // See C1594, first paragraph. These conditions enable checks on both
- // left-hand and right-hand sides in various circumstances.
- if (IsHostAssociatedIntoSubprogram(x, scope)) {
- return "host-associated";
- } else if (IsUseAssociated(x, scope)) {
- return "USE-associated";
- } else if (IsPointerDummyOfPureFunction(x)) {
- return "a POINTER dummy argument of a pure function";
- } else if (IsIntentIn(x)) {
- return "an INTENT(IN) dummy argument";
- } else if (FindCommonBlockContaining(x)) {
- return "in a COMMON block";
- } else {
- return nullptr;
- }
-}
-
-// Checks C1594(1,2); false if check fails
-bool CheckDefinabilityInPureScope(parser::ContextualMessages &messages,
- const Symbol &lhs, const Scope &context, const Scope &pure) {
- if (pure.symbol()) {
- if (const char *why{WhyBaseObjectIsSuspicious(lhs, context)}) {
- evaluate::SayWithDeclaration(messages, lhs,
- "Pure subprogram '%s' may not define '%s' because it is %s"_err_en_US,
- pure.symbol()->name(), lhs.name(), why);
- return false;
- }
+ CheckForPureContext(rhs, std::get<parser::Expr>(stmt.t).source, true);
+ parser::CharBlock at{context_.location().value()};
+ auto restorer{foldingContext().messages().SetLocation(at)};
+ const Scope &scope{context_.FindScope(at)};
+ CheckPointerAssignment(foldingContext(), *assignment, scope);
}
- return true;
}
static std::optional<std::string> GetPointerComponentDesignatorName(
@@ -149,7 +111,8 @@ static std::optional<std::string> GetPointerComponentDesignatorName(
bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
const SomeExpr &expr, const Scope &scope) {
if (const Symbol * base{GetFirstSymbol(expr)}) {
- if (const char *why{WhyBaseObjectIsSuspicious(*base, scope)}) {
+ if (const char *why{
+ WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)}) {
if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
evaluate::SayWithDeclaration(messages, *base,
"A pure subprogram may not copy the value of '%s' because it is %s"
@@ -162,56 +125,26 @@ bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
return true;
}
-bool AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
- const SomeExpr &rhs, parser::CharBlock source, bool isPointerAssignment) {
- const Scope &scope{context_.FindScope(source)};
- if (const Scope * pure{FindPureProcedureContaining(scope)}) {
- parser::ContextualMessages messages{
- context_.location().value(), &context_.messages()};
- if (evaluate::ExtractCoarrayRef(lhs)) {
- messages.Say(
- "A pure subprogram may not define a coindexed object"_err_en_US);
- } else if (const Symbol * base{GetFirstSymbol(lhs)}) {
- if (const auto *assoc{base->detailsIf<AssocEntityDetails>()}) {
- auto dataRef{ExtractDataRef(assoc->expr(), true)};
- // ASSOCIATE(a=>x) -- check x, not a, for "a=..."
- base = dataRef ? &dataRef->GetFirstSymbol() : nullptr;
- }
- if (base &&
- !CheckDefinabilityInPureScope(messages, *base, scope, *pure)) {
- return false;
- }
- }
- if (isPointerAssignment) {
- if (const Symbol * base{GetFirstSymbol(rhs)}) {
- if (const char *why{
- WhyBaseObjectIsSuspicious(*base, scope)}) { // C1594(3)
- evaluate::SayWithDeclaration(messages, *base,
- "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
- base->name(), why);
- return false;
- }
- }
- } else if (auto type{evaluate::DynamicType::From(lhs)}) {
- // C1596 checks for polymorphic deallocation in a pure subprogram
- // due to automatic reallocation on assignment
- if (type->IsPolymorphic()) {
- context_.Say(
- "Deallocation of polymorphic object is not permitted in a pure subprogram"_err_en_US);
+bool AssignmentContext::CheckForPureContext(const SomeExpr &rhs,
+ parser::CharBlock rhsSource, bool isPointerAssignment) {
+ const Scope &scope{context_.FindScope(rhsSource)};
+ if (!FindPureProcedureContaining(scope)) {
+ return true;
+ }
+ parser::ContextualMessages messages{
+ context_.location().value(), &context_.messages()};
+ if (isPointerAssignment) {
+ if (const Symbol * base{GetFirstSymbol(rhs)}) {
+ if (const char *why{WhyBaseObjectIsSuspicious(
+ base->GetUltimate(), scope)}) { // C1594(3)
+ evaluate::SayWithDeclaration(messages, *base,
+ "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
+ base->name(), why);
return false;
}
- if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
- if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
- *derived)}) {
- evaluate::SayWithDeclaration(messages, *bad,
- "Deallocation of polymorphic non-coarray component '%s' is not permitted in a pure subprogram"_err_en_US,
- bad.BuildResultDesignatorName());
- return false;
- } else {
- return CheckCopyabilityInPureScope(messages, rhs, scope);
- }
- }
}
+ } else {
+ return CheckCopyabilityInPureScope(messages, rhs, scope);
}
return true;
}
diff --git a/flang/lib/Semantics/assignment.h b/flang/lib/Semantics/assignment.h
index 65345ab7912a9..95d7b3cf91b17 100644
--- a/flang/lib/Semantics/assignment.h
+++ b/flang/lib/Semantics/assignment.h
@@ -29,9 +29,6 @@ class AssignmentContext;
class Scope;
class Symbol;
-// Applies checks from C1594(1-2) on definitions in pure subprograms
-bool CheckDefinabilityInPureScope(parser::ContextualMessages &, const Symbol &,
- const Scope &context, const Scope &pure);
// Applies checks from C1594(5-6) on copying pointers in pure subprograms
bool CheckCopyabilityInPureScope(parser::ContextualMessages &,
const evaluate::Expr<evaluate::SomeType> &, const Scope &);
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index d36ddd3623ba7..45b5c293cf18f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "check-call.h"
+#include "definable.h"
#include "pointer-assignment.h"
#include "flang/Evaluate/characteristics.h"
#include "flang/Evaluate/check-expression.h"
@@ -397,13 +398,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
reason = "INTENT(IN OUT)";
}
if (reason && scope) {
- bool vectorSubscriptIsOk{isElemental || dummyIsValue}; // 15.5.2.4(21)
- if (auto why{WhyNotModifiable(
- messages.at(), actual, *scope, vectorSubscriptIsOk)}) {
+ DefinabilityFlags flags;
+ if (isElemental || dummyIsValue) { // 15.5.2.4(21)
+ flags.set(DefinabilityFlag::VectorSubscriptIsOk);
+ }
+ if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
if (auto *msg{messages.Say(
- "Actual argument associated with %s %s must be definable"_err_en_US,
+ "Actual argument associated with %s %s is not definable"_err_en_US,
reason, dummyName)}) {
- msg->Attach(*why);
+ msg->Attach(std::move(*whyNot));
}
}
}
@@ -467,8 +470,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
if (!actualIsPointer) {
if (dummy.intent == common::Intent::In) {
- semantics::CheckPointerAssignment(
- context, parser::CharBlock{}, dummyName, dummy, actual);
+ if (scope) {
+ semantics::CheckPointerAssignment(
+ context, messages.at(), dummyName, dummy, actual, *scope);
+ }
} else {
messages.Say(
"Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 0df66b4086e9e..e0efaa7746a3e 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -680,7 +680,8 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
if (auto designator{evaluate::AsGenericExpr(symbol)}) {
auto restorer{messages_.SetLocation(symbol.name())};
context_.set_location(symbol.name());
- CheckInitialTarget(foldingContext_, *designator, *object->init());
+ CheckInitialTarget(
+ foldingContext_, *designator, *object->init(), DEREF(scope_));
}
}
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 6322a6570b05d..5e25e51ec1691 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "check-io.h"
+#include "definable.h"
#include "flang/Common/format.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/tools.h"
@@ -1005,11 +1006,12 @@ void IoChecker::CheckForDefinableVariable(
if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
if (auto expr{AnalyzeExpr(context_, *var)}) {
auto at{var->GetSource()};
- if (auto whyNot{WhyNotModifiable(at, *expr, context_.FindScope(at),
- true /*vectorSubscriptIsOk*/)}) {
+ if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
+ DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
+ *expr)}) {
const Symbol *base{GetFirstSymbol(*expr)};
context_
- .Say(at, "%s variable '%s' must be definable"_err_en_US, s,
+ .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
(base ? base->name() : at).ToString())
.Attach(std::move(*whyNot));
}
diff --git a/flang/lib/Semantics/check-nullify.cpp b/flang/lib/Semantics/check-nullify.cpp
index 7624f7973d2a9..a3d353198d1af 100644
--- a/flang/lib/Semantics/check-nullify.cpp
+++ b/flang/lib/Semantics/check-nullify.cpp
@@ -7,7 +7,7 @@
//===----------------------------------------------------------------------===//
#include "check-nullify.h"
-#include "assignment.h"
+#include "definable.h"
#include "flang/Evaluate/expression.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
@@ -19,37 +19,32 @@ namespace Fortran::semantics {
void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
CHECK(context_.location());
const Scope &scope{context_.FindScope(*context_.location())};
- const Scope *pure{FindPureProcedureContaining(scope)};
- parser::ContextualMessages messages{
- *context_.location(), &context_.messages()};
for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
common::visit(
common::visitors{
[&](const parser::Name &name) {
- const Symbol *symbol{name.symbol};
- if (context_.HasError(symbol)) {
- // already reported an error
- } else if (!IsVariableName(*symbol) &&
- !IsProcedurePointer(*symbol)) {
- messages.Say(name.source,
- "name in NULLIFY statement must be a variable or procedure pointer"_err_en_US);
- } else if (!IsPointer(*symbol)) { // C951
- messages.Say(name.source,
- "name in NULLIFY statement must have the POINTER attribute"_err_en_US);
- } else if (pure) {
- CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
+ if (name.symbol) {
+ if (auto whyNot{WhyNotDefinable(name.source, scope,
+ DefinabilityFlags{DefinabilityFlag::PointerDefinition},
+ *name.symbol)}) {
+ context_.messages()
+ .Say(name.source,
+ "'%s' may not appear in NULLIFY"_err_en_US,
+ name.source)
+ .Attach(std::move(*whyNot));
+ }
}
},
[&](const parser::StructureComponent &structureComponent) {
+ const auto &component{structureComponent.component};
+ SourceName at{component.source};
if (const auto *checkedExpr{GetExpr(context_, pointerObject)}) {
- if (!IsPointer(*structureComponent.component.symbol)) { // C951
- messages.Say(structureComponent.component.source,
- "component in NULLIFY statement must have the POINTER attribute"_err_en_US);
- } else if (pure) {
- if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
- CheckDefinabilityInPureScope(
- messages, *symbol, scope, *pure);
- }
+ if (auto whyNot{WhyNotDefinable(at, scope,
+ DefinabilityFlags{DefinabilityFlag::PointerDefinition},
+ *checkedExpr)}) {
+ context_.messages()
+ .Say(at, "'%s' may not appear in NULLIFY"_err_en_US, at)
+ .Attach(std::move(*whyNot));
}
}
},
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index fee4f14895d68..bb983564acb54 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "check-omp-structure.h"
+#include "definable.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/tools.h"
#include <algorithm>
@@ -1963,9 +1964,9 @@ void OmpStructureChecker::CheckIntentInPointerAndDefinable(
"in a %s clause"_err_en_US,
symbol->name(),
parser::ToUpperCaseLetters(getClauseName(clause).str()));
- }
- if (auto msg{
- WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
+ } else if (auto msg{WhyNotDefinable(name->source,
+ context_.FindScope(name->source), DefinabilityFlags{},
+ *symbol)}) {
context_
.Say(GetContext().clauseSource,
"Variable '%s' on the %s clause is not definable"_err_en_US,
@@ -2572,7 +2573,8 @@ void OmpStructureChecker::CheckDefinableObjects(
for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
const auto *symbol{it->first};
const auto source{it->second};
- if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
+ if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
+ DefinabilityFlags{}, *symbol)}) {
context_
.Say(source,
"Variable '%s' on the %s clause is not definable"_err_en_US,
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 281b8a3a93802..70d16532d240d 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -123,6 +123,7 @@ class DataInitializationCompiler {
DataInitializations &inits_;
evaluate::ExpressionAnalyzer &exprAnalyzer_;
ValueListIterator<DSV> values_;
+ const Scope *scope_{nullptr};
};
template <typename DSV>
@@ -141,7 +142,9 @@ bool DataInitializationCompiler<DSV>::Scan(
template <typename DSV>
bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
if (const auto *expr{GetExpr(exprAnalyzer_.context(), var)}) {
- exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
+ parser::CharBlock at{var.GetSource()};
+ exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
+ scope_ = &exprAnalyzer_.context().FindScope(at);
if (InitDesignator(*expr)) {
return true;
}
@@ -153,8 +156,9 @@ template <typename DSV>
bool DataInitializationCompiler<DSV>::Scan(
const parser::Designator &designator) {
if (auto expr{exprAnalyzer_.Analyze(designator)}) {
- exprAnalyzer_.GetFoldingContext().messages().SetLocation(
- parser::FindSourceLocation(designator));
+ parser::CharBlock at{parser::FindSourceLocation(designator)};
+ exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
+ scope_ = &exprAnalyzer_.context().FindScope(at);
if (InitDesignator(*expr)) {
return true;
}
@@ -361,7 +365,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
return true;
} else if (isProcPointer) {
if (evaluate::IsProcedure(*expr)) {
- if (CheckPointerAssignment(context, designator, *expr)) {
+ if (CheckPointerAssignment(context, designator, *expr, DEREF(scope_))) {
if (lastSymbol->has<ProcEntityDetails>()) {
GetImage().AddPointer(offsetSymbol.offset(), *expr);
return true;
@@ -382,7 +386,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
exprAnalyzer_.Say(
"Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
expr->AsFortran(), DescribeElement());
- } else if (CheckInitialTarget(context, designator, *expr)) {
+ } else if (CheckInitialTarget(context, designator, *expr, DEREF(scope_))) {
GetImage().AddPointer(offsetSymbol.offset(), *expr);
return true;
}
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
new file mode 100644
index 0000000000000..33dcc85c6e767
--- /dev/null
+++ b/flang/lib/Semantics/definable.cpp
@@ -0,0 +1,246 @@
+//===-- lib/Semantics/definable.cpp ---------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "definable.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Semantics/tools.h"
+
+using namespace Fortran::parser::literals;
+
+namespace Fortran::semantics {
+
+template <typename... A>
+static parser::Message BlameSymbol(parser::CharBlock at,
+ const parser::MessageFixedText &text, const Symbol &original, A &&...x) {
+ parser::Message message{at, text, original.name(), std::forward<A>(x)...};
+ message.set_severity(parser::Severity::Because);
+ evaluate::AttachDeclaration(message, original);
+ return message;
+}
+
+static bool IsPointerDummyOfPureFunction(const Symbol &x) {
+ return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
+ x.owner().symbol() && IsFunction(*x.owner().symbol());
+}
+
+// See C1594, first paragraph. These conditions enable checks on both
+// left-hand and right-hand sides in various circumstances.
+const char *WhyBaseObjectIsSuspicious(const Symbol &x, const Scope &scope) {
+ if (IsHostAssociatedIntoSubprogram(x, scope)) {
+ return "host-associated";
+ } else if (IsUseAssociated(x, scope)) {
+ return "USE-associated";
+ } else if (IsPointerDummyOfPureFunction(x)) {
+ return "a POINTER dummy argument of a pure function";
+ } else if (IsIntentIn(x)) {
+ return "an INTENT(IN) dummy argument";
+ } else if (FindCommonBlockContaining(x)) {
+ return "in a COMMON block";
+ } else {
+ return nullptr;
+ }
+}
+
+// Checks C1594(1,2); false if check fails
+static std::optional<parser::Message> CheckDefinabilityInPureScope(
+ SourceName at, const Symbol &original, const Symbol &ultimate,
+ const Scope &context, const Scope &pure) {
+ if (pure.symbol()) {
+ if (const char *why{WhyBaseObjectIsSuspicious(ultimate, context)}) {
+ return BlameSymbol(at,
+ "'%s' may not be defined in pure subprogram '%s' because it is %s"_en_US,
+ original, pure.symbol()->name(), why);
+ }
+ }
+ return std::nullopt;
+}
+
+// When a DataRef contains pointers, gets the rightmost one (unless it is
+// the entity being defined, in which case the last pointer above it);
+// otherwise, returns the leftmost symbol. The resulting symbol is the
+// relevant base object for definabiliy checking. Examples:
+// ptr1%ptr2 => ... -> ptr1
+// nonptr%ptr => ... -> nonptr
+// nonptr%ptr = ... -> ptr
+// ptr1%ptr2 = ... -> ptr2
+// ptr1%ptr2%nonptr = ... -> ptr2
+// nonptr1%nonptr2 = ... -> nonptr1
+static const Symbol &GetRelevantSymbol(
+ const evaluate::DataRef &dataRef, bool isPointerDefinition) {
+ if (isPointerDefinition) {
+ if (const auto *component{std::get_if<evaluate::Component>(&dataRef.u)}) {
+ if (IsPointer(component->GetLastSymbol())) {
+ return GetRelevantSymbol(component->base(), false);
+ }
+ }
+ }
+ if (const Symbol * lastPointer{GetLastPointerSymbol(dataRef)}) {
+ return *lastPointer;
+ } else {
+ return dataRef.GetFirstSymbol();
+ }
+}
+
+// Check the leftmost (or only) symbol from a data-ref or expression.
+static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+ const Symbol &ultimate{original.GetUltimate()};
+ bool isPointerDefinition{flags.test(DefinabilityFlag::PointerDefinition)};
+ bool isTargetDefinition{!isPointerDefinition && IsPointer(ultimate)};
+ if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()}) {
+ if (association->rank().has_value()) {
+ return std::nullopt; // SELECT RANK always modifiable variable
+ } else if (!IsVariable(association->expr())) {
+ return BlameSymbol(at,
+ "'%s' is construct associated with an expression"_en_US, original);
+ } else if (evaluate::HasVectorSubscript(association->expr().value())) {
+ return BlameSymbol(at,
+ "Construct association '%s' has a vector subscript"_en_US, original);
+ } else if (auto dataRef{evaluate::ExtractDataRef(
+ *association->expr(), true, true)}) {
+ return WhyNotDefinableBase(
+ at, scope, flags, GetRelevantSymbol(*dataRef, isPointerDefinition));
+ }
+ }
+ if (isTargetDefinition) {
+ } else if (!isPointerDefinition && !IsVariableName(ultimate)) {
+ return BlameSymbol(at, "'%s' is not a variable"_en_US, original);
+ } else if (IsProtected(ultimate) && IsUseAssociated(original, scope)) {
+ return BlameSymbol(at, "'%s' is protected in this scope"_en_US, original);
+ } else if (IsIntentIn(ultimate)) {
+ return BlameSymbol(
+ at, "'%s' is an INTENT(IN) dummy argument"_en_US, original);
+ }
+ if (const Scope * pure{FindPureProcedureContaining(scope)}) {
+ // Additional checking for pure subprograms.
+ if (!isTargetDefinition) {
+ if (auto msg{CheckDefinabilityInPureScope(
+ at, original, ultimate, scope, *pure)}) {
+ return msg;
+ }
+ }
+ if (const Symbol *
+ visible{FindExternallyVisibleObject(
+ ultimate, *pure, isPointerDefinition)}) {
+ return BlameSymbol(at,
+ "'%s' is externally visible via '%s' and not definable in a pure subprogram"_en_US,
+ original, visible->name());
+ }
+ }
+ return std::nullopt;
+}
+
+static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+ const Symbol &ultimate{original.GetUltimate()};
+ if (flags.test(DefinabilityFlag::PointerDefinition)) {
+ if (!IsPointer(ultimate)) {
+ return BlameSymbol(at, "'%s' is not a pointer"_en_US, original);
+ }
+ return std::nullopt; // pointer assignment - skip following checks
+ }
+ if (IsOrContainsEventOrLockComponent(ultimate)) {
+ return BlameSymbol(at,
+ "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
+ original);
+ }
+ if (FindPureProcedureContaining(scope)) {
+ if (auto dyType{evaluate::DynamicType::From(ultimate)}) {
+ if (dyType->IsPolymorphic()) { // C1596
+ return BlameSymbol(at,
+ "'%s' is polymorphic in a pure subprogram"_because_en_US, original);
+ }
+ if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
+ if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
+ *derived)}) {
+ return BlameSymbol(at,
+ "'%s' has polymorphic non-coarray component '%s' in a pure subprogram"_because_en_US,
+ original, bad.BuildResultDesignatorName());
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
+// Checks a data-ref
+static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags,
+ const evaluate::DataRef &dataRef) {
+ const Symbol &base{GetRelevantSymbol(
+ dataRef, flags.test(DefinabilityFlag::PointerDefinition))};
+ if (auto whyNot{WhyNotDefinableBase(at, scope, flags, base)}) {
+ return whyNot;
+ } else {
+ return WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol());
+ }
+}
+
+// Checks a NOPASS procedure pointer component
+static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags,
+ const evaluate::Component &component) {
+ const evaluate::DataRef &dataRef{component.base()};
+ const Symbol &base{GetRelevantSymbol(dataRef, false)};
+ DefinabilityFlags baseFlags{flags};
+ baseFlags.reset(DefinabilityFlag::PointerDefinition);
+ return WhyNotDefinableBase(at, scope, baseFlags, base);
+}
+
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+ if (auto base{WhyNotDefinableBase(at, scope, flags, original)}) {
+ return base;
+ }
+ return WhyNotDefinableLast(at, scope, flags, original);
+}
+
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+ const Scope &scope, DefinabilityFlags flags,
+ const evaluate::Expr<evaluate::SomeType> &expr) {
+ if (auto dataRef{evaluate::ExtractDataRef(expr, true, true)}) {
+ if (!flags.test(DefinabilityFlag::VectorSubscriptIsOk) &&
+ evaluate::HasVectorSubscript(expr)) {
+ return parser::Message{at,
+ "Variable '%s' has a vector subscript"_because_en_US,
+ expr.AsFortran()};
+ }
+ if (FindPureProcedureContaining(scope) &&
+ evaluate::ExtractCoarrayRef(expr)) {
+ return parser::Message(at,
+ "A pure subprogram may not define the coindexed object '%s'"_because_en_US,
+ expr.AsFortran());
+ }
+ return WhyNotDefinable(at, scope, flags, *dataRef);
+ }
+ if (evaluate::IsVariable(expr)) {
+ return std::nullopt; // result of function returning a pointer - ok
+ }
+ if (flags.test(DefinabilityFlag::PointerDefinition)) {
+ if (const auto *procDesignator{
+ std::get_if<evaluate::ProcedureDesignator>(&expr.u)}) {
+ // Defining a procedure pointer
+ if (const Symbol * procSym{procDesignator->GetSymbol()}) {
+ if (evaluate::ExtractCoarrayRef(expr)) { // C1027
+ return BlameSymbol(at,
+ "Procedure pointer '%s' may not be a coindexed object"_because_en_US,
+ *procSym, expr.AsFortran());
+ }
+ if (const auto *component{procDesignator->GetComponent()}) {
+ return WhyNotDefinable(at, scope, flags, *component);
+ } else {
+ return WhyNotDefinable(at, scope, flags, *procSym);
+ }
+ }
+ }
+ }
+ return parser::Message{
+ at, "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
+}
+
+} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h
new file mode 100644
index 0000000000000..7ef9ba8b33c1c
--- /dev/null
+++ b/flang/lib/Semantics/definable.h
@@ -0,0 +1,50 @@
+//===-- lib/Semantics/definable.h -------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_DEFINABLE_H_
+#define FORTRAN_SEMANTICS_DEFINABLE_H_
+
+// Utilities for checking the definability of variables and pointers in context,
+// including checks for attempted definitions in PURE subprograms.
+// Fortran 2018 C1101, C1158, C1594, &c.
+
+#include "flang/Common/enum-set.h"
+#include "flang/Common/idioms.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/message.h"
+#include <optional>
+
+namespace Fortran::semantics {
+
+class Symbol;
+class Scope;
+
+ENUM_CLASS(DefinabilityFlag,
+ VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment)
+ PointerDefinition) // a pointer is being defined, not its target
+
+using DefinabilityFlags =
+ common::EnumSet<DefinabilityFlag, DefinabilityFlag_enumSize>;
+
+// Tests a symbol or LHS variable or pointer for definability in a given scope.
+// When the entity is not definable, returns a "because:" Message suitable for
+// attachment to an error message to explain why the entity cannot be defined.
+// When the entity can be defined in that context, returns std::nullopt.
+std::optional<parser::Message> WhyNotDefinable(
+ parser::CharBlock, const Scope &, DefinabilityFlags, const Symbol &);
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock, const Scope &,
+ DefinabilityFlags, const evaluate::Expr<evaluate::SomeType> &);
+
+// If a symbol would not be definable in a pure scope, or not be usable as the
+// target of a pointer assignment in a pure scope, return a constant string
+// describing why.
+const char *WhyBaseObjectIsSuspicious(const Symbol &, const Scope &);
+
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_DEFINABLE_H_
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 2fad785a62272..3853b2eebc6b4 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1808,11 +1808,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
unavailable.insert(symbol->name());
if (value) {
+ const auto &innermost{context_.FindScope(expr.source)};
if (symbol->has<semantics::ProcEntityDetails>()) {
CHECK(IsPointer(*symbol));
} else if (symbol->has<semantics::ObjectEntityDetails>()) {
// C1594(4)
- const auto &innermost{context_.FindScope(expr.source)};
if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
if (const Symbol * pointer{FindPointerComponent(*symbol)}) {
if (const Symbol *
@@ -1842,8 +1842,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(
continue;
}
if (IsPointer(*symbol)) {
- semantics::CheckPointerAssignment(
- GetFoldingContext(), *symbol, *value); // C7104, C7105
+ semantics::CheckStructConstructorPointerComponent(
+ GetFoldingContext(), *symbol, *value, innermost); // C7104, C7105
result.Add(*symbol, Fold(std::move(*value)));
} else if (MaybeExpr converted{
ConvertToType(*symbol, std::move(*value))}) {
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 54e36f5b085bd..7661a36faaef4 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "pointer-assignment.h"
+#include "definable.h"
#include "flang/Common/idioms.h"
#include "flang/Common/restorer.h"
#include "flang/Evaluate/characteristics.h"
@@ -40,10 +41,13 @@ using parser::MessageFormattedText;
class PointerAssignmentChecker {
public:
PointerAssignmentChecker(evaluate::FoldingContext &context,
- parser::CharBlock source, const std::string &description)
- : context_{context}, source_{source}, description_{description} {}
- PointerAssignmentChecker(evaluate::FoldingContext &context, const Symbol &lhs)
- : context_{context}, source_{lhs.name()},
+ const Scope &scope, parser::CharBlock source,
+ const std::string &description)
+ : context_{context}, scope_{scope}, source_{source}, description_{
+ description} {}
+ PointerAssignmentChecker(
+ evaluate::FoldingContext &context, const Scope &scope, const Symbol &lhs)
+ : context_{context}, scope_{scope}, source_{lhs.name()},
description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
set_lhsType(TypeAndShape::Characterize(lhs, context));
set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
@@ -53,6 +57,7 @@ class PointerAssignmentChecker {
PointerAssignmentChecker &set_isContiguous(bool);
PointerAssignmentChecker &set_isVolatile(bool);
PointerAssignmentChecker &set_isBoundsRemapping(bool);
+ bool CheckLeftHandSide(const SomeExpr &);
bool Check(const SomeExpr &);
private:
@@ -72,6 +77,7 @@ class PointerAssignmentChecker {
template <typename... A> parser::Message *Say(A &&...);
evaluate::FoldingContext &context_;
+ const Scope &scope_;
const parser::CharBlock source_;
const std::string description_;
const Symbol *lhs_{nullptr};
@@ -117,6 +123,19 @@ bool PointerAssignmentChecker::CharacterizeProcedure() {
return procedure_.has_value();
}
+bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
+ if (auto whyNot{WhyNotDefinable(context_.messages().at(), scope_,
+ DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
+ if (auto *msg{context_.messages().Say(
+ "The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
+ msg->Attach(std::move(*whyNot));
+ }
+ return false;
+ } else {
+ return true;
+ }
+}
+
template <typename T> bool PointerAssignmentChecker::Check(const T &) {
// Catch-all case for really bad target expression
Say("Target associated with %s must be a designator or a call to a"
@@ -395,43 +414,34 @@ static bool CheckPointerBounds(
return isBoundsRemapping;
}
-bool CheckPointerAssignment(
- evaluate::FoldingContext &context, const evaluate::Assignment &assignment) {
- return CheckPointerAssignment(context, assignment.lhs, assignment.rhs,
+bool CheckPointerAssignment(evaluate::FoldingContext &context,
+ const evaluate::Assignment &assignment, const Scope &scope) {
+ return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
CheckPointerBounds(context, assignment));
}
bool CheckPointerAssignment(evaluate::FoldingContext &context,
- const SomeExpr &lhs, const SomeExpr &rhs, bool isBoundsRemapping) {
+ const SomeExpr &lhs, const SomeExpr &rhs, const Scope &scope,
+ bool isBoundsRemapping) {
const Symbol *pointer{GetLastSymbol(lhs)};
if (!pointer) {
return false; // error was reported
}
- if (!IsPointer(pointer->GetUltimate())) {
- evaluate::SayWithDeclaration(context.messages(), *pointer,
- "'%s' is not a pointer"_err_en_US, pointer->name());
- return false;
- }
- if (pointer->has<ProcEntityDetails>() && evaluate::ExtractCoarrayRef(lhs)) {
- context.messages().Say( // C1027
- "Procedure pointer may not be a coindexed object"_err_en_US);
- return false;
- }
- return PointerAssignmentChecker{context, *pointer}
- .set_isBoundsRemapping(isBoundsRemapping)
- .Check(rhs);
+ PointerAssignmentChecker checker{context, scope, *pointer};
+ checker.set_isBoundsRemapping(isBoundsRemapping);
+ return checker.CheckLeftHandSide(lhs) & checker.Check(rhs);
}
-bool CheckPointerAssignment(
- evaluate::FoldingContext &context, const Symbol &lhs, const SomeExpr &rhs) {
+bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &context,
+ const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
CHECK(IsPointer(lhs));
- return PointerAssignmentChecker{context, lhs}.Check(rhs);
+ return PointerAssignmentChecker{context, scope, lhs}.Check(rhs);
}
bool CheckPointerAssignment(evaluate::FoldingContext &context,
parser::CharBlock source, const std::string &description,
- const DummyDataObject &lhs, const SomeExpr &rhs) {
- return PointerAssignmentChecker{context, source, description}
+ const DummyDataObject &lhs, const SomeExpr &rhs, const Scope &scope) {
+ return PointerAssignmentChecker{context, scope, source, description}
.set_lhsType(common::Clone(lhs.type))
.set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
.set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
@@ -439,9 +449,9 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
}
bool CheckInitialTarget(evaluate::FoldingContext &context,
- const SomeExpr &pointer, const SomeExpr &init) {
+ const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
return evaluate::IsInitialDataTarget(init, &context.messages()) &&
- CheckPointerAssignment(context, pointer, init);
+ CheckPointerAssignment(context, pointer, init, scope);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/pointer-assignment.h b/flang/lib/Semantics/pointer-assignment.h
index 670e4e7ed5ea7..95ed67d1de5ab 100644
--- a/flang/lib/Semantics/pointer-assignment.h
+++ b/flang/lib/Semantics/pointer-assignment.h
@@ -27,19 +27,20 @@ namespace Fortran::semantics {
class Symbol;
bool CheckPointerAssignment(
- evaluate::FoldingContext &, const evaluate::Assignment &);
+ evaluate::FoldingContext &, const evaluate::Assignment &, const Scope &);
bool CheckPointerAssignment(evaluate::FoldingContext &, const SomeExpr &lhs,
- const SomeExpr &rhs, bool isBoundsRemapping = false);
-bool CheckPointerAssignment(
- evaluate::FoldingContext &, const Symbol &lhs, const SomeExpr &rhs);
+ const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
+bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &,
+ const Symbol &lhs, const SomeExpr &rhs, const Scope &);
bool CheckPointerAssignment(evaluate::FoldingContext &,
parser::CharBlock source, const std::string &description,
- const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs);
+ const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
+ const Scope &);
// Checks whether an expression is a valid static initializer for a
// particular pointer designator.
-bool CheckInitialTarget(
- evaluate::FoldingContext &, const SomeExpr &pointer, const SomeExpr &init);
+bool CheckInitialTarget(evaluate::FoldingContext &, const SomeExpr &pointer,
+ const SomeExpr &init, const Scope &);
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4daf87518c26d..5f82f7459a23d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7,6 +7,7 @@
#include "resolve-names.h"
#include "assignment.h"
+#include "definable.h"
#include "mod-file.h"
#include "pointer-assignment.h"
#include "program-tree.h"
@@ -5744,11 +5745,12 @@ bool DeclarationVisitor::PassesLocalityChecks(
"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
return false;
}
- if (std::optional<Message> msg{WhyNotModifiable(symbol, currScope())}) {
+ if (std::optional<Message> whyNot{WhyNotDefinable(
+ name.source, currScope(), DefinabilityFlags{}, symbol)}) {
SayWithReason(name, symbol,
"'%s' may not appear in a locality-spec because it is not "
"definable"_err_en_US,
- std::move(*msg));
+ std::move(*whyNot));
return false;
}
return PassesSharedLocalityChecks(name, symbol);
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 4b57f141a9207..6bf2a574fe3fa 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -221,10 +221,9 @@ bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
}
bool IsUseAssociated(const Symbol &symbol, const Scope &scope) {
- const Scope &owner{
- GetProgramUnitOrBlockConstructContaining(symbol.GetUltimate().owner())};
+ const Scope &owner{GetTopLevelUnitContaining(symbol.GetUltimate().owner())};
return owner.kind() == Scope::Kind::Module &&
- owner != GetProgramUnitOrBlockConstructContaining(scope);
+ owner != GetTopLevelUnitContaining(scope);
}
bool DoesScopeContain(
@@ -362,7 +361,7 @@ const Symbol *FindPointerComponent(const Symbol &symbol) {
// C1594 specifies several ways by which an object might be globally visible.
const Symbol *FindExternallyVisibleObject(
- const Symbol &object, const Scope &scope) {
+ const Symbol &object, const Scope &scope, bool isPointerDefinition) {
// TODO: Storage association with any object for which this predicate holds,
// once EQUIVALENCE is supported.
const Symbol &ultimate{GetAssociationRoot(object)};
@@ -370,10 +369,12 @@ const Symbol *FindExternallyVisibleObject(
if (IsIntentIn(ultimate)) {
return &ultimate;
}
- if (IsPointer(ultimate) && IsPureProcedure(ultimate.owner()) &&
- IsFunction(ultimate.owner())) {
+ if (!isPointerDefinition && IsPointer(ultimate) &&
+ IsPureProcedure(ultimate.owner()) && IsFunction(ultimate.owner())) {
return &ultimate;
}
+ } else if (ultimate.owner().IsDerivedType()) {
+ return nullptr;
} else if (&GetProgramUnitContaining(ultimate) !=
&GetProgramUnitContaining(scope)) {
return &object;
@@ -776,13 +777,6 @@ std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &scope) {
bool IsModuleProcedure(const Symbol &symbol) {
return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module;
}
-const Symbol *IsExternalInPureContext(
- const Symbol &symbol, const Scope &scope) {
- if (const auto *pureProc{FindPureProcedureContaining(scope)}) {
- return FindExternallyVisibleObject(symbol.GetUltimate(), *pureProc);
- }
- return nullptr;
-}
PotentialComponentIterator::const_iterator FindPolymorphicPotentialComponent(
const DerivedTypeSpec &derived) {
@@ -812,114 +806,6 @@ bool IsOrContainsPolymorphicComponent(const Symbol &original) {
return false;
}
-bool InProtectedContext(const Symbol &symbol, const Scope ¤tScope) {
- return IsProtected(symbol) && !IsHostAssociated(symbol, currentScope);
-}
-
-// C1101 and C1158
-// Modifiability checks on the leftmost symbol ("base object")
-// of a data-ref
-static std::optional<parser::Message> WhyNotModifiableFirst(
- parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
- if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
- if (assoc->rank().has_value()) {
- return std::nullopt; // SELECT RANK always modifiable variable
- } else if (IsVariable(assoc->expr())) {
- if (evaluate::HasVectorSubscript(assoc->expr().value())) {
- return parser::Message{
- at, "Construct association has a vector subscript"_en_US};
- } else {
- return WhyNotModifiable(at, *assoc->expr(), scope);
- }
- } else {
- return parser::Message{at,
- "'%s' is construct associated with an expression"_en_US,
- symbol.name()};
- }
- } else if (IsExternalInPureContext(symbol, scope)) {
- return parser::Message{at,
- "'%s' is externally visible and referenced in a pure"
- " procedure"_en_US,
- symbol.name()};
- } else if (!IsVariableName(symbol)) {
- return parser::Message{at, "'%s' is not a variable"_en_US, symbol.name()};
- } else {
- return std::nullopt;
- }
-}
-
-// Modifiability checks on the rightmost symbol of a data-ref
-static std::optional<parser::Message> WhyNotModifiableLast(
- parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
- if (IsOrContainsEventOrLockComponent(symbol)) {
- return parser::Message{at,
- "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
- symbol.name()};
- } 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.
-static std::optional<parser::Message> WhyNotModifiableIfNoPtr(
- parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
- if (InProtectedContext(symbol, scope)) {
- return parser::Message{
- at, "'%s' is protected in this scope"_en_US, symbol.name()};
- } else if (IsIntentIn(symbol)) {
- return parser::Message{
- at, "'%s' is an INTENT(IN) dummy argument"_en_US, symbol.name()};
- } else {
- return std::nullopt;
- }
-}
-
-// Apply all modifiability checks to a single symbol
-std::optional<parser::Message> WhyNotModifiable(
- const Symbol &original, const Scope &scope) {
- const Symbol &symbol{GetAssociationRoot(original)};
- if (auto first{WhyNotModifiableFirst(symbol.name(), symbol, scope)}) {
- return first;
- } else if (auto last{WhyNotModifiableLast(symbol.name(), symbol, scope)}) {
- return last;
- } else if (!IsPointer(symbol)) {
- return WhyNotModifiableIfNoPtr(symbol.name(), 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 (auto dataRef{evaluate::ExtractDataRef(expr, true)}) {
- if (!vectorSubscriptIsOk && evaluate::HasVectorSubscript(expr)) {
- return parser::Message{at, "Variable has a vector subscript"_en_US};
- }
- const Symbol &first{GetAssociationRoot(dataRef->GetFirstSymbol())};
- if (auto maybeWhyFirst{WhyNotModifiableFirst(at, first, scope)}) {
- return maybeWhyFirst;
- }
- const Symbol &last{dataRef->GetLastSymbol()};
- if (auto maybeWhyLast{WhyNotModifiableLast(at, last, scope)}) {
- return maybeWhyLast;
- }
- if (!GetLastPointerSymbol(*dataRef)) {
- if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(at, first, scope)}) {
- return maybeWhyFirst;
- }
- }
- } else if (!evaluate::IsVariable(expr)) {
- return parser::Message{
- at, "'%s' is not a variable"_en_US, expr.AsFortran()};
- } else {
- // reference to function returning POINTER
- }
- return std::nullopt;
-}
-
class ImageControlStmtHelper {
using ImageControlStmts =
std::variant<parser::ChangeTeamConstruct, parser::CriticalConstruct,
diff --git a/flang/test/Semantics/OpenMP/omp-lastprivate01.f90 b/flang/test/Semantics/OpenMP/omp-lastprivate01.f90
index acf91b81fb152..4fae4829d8862 100644
--- a/flang/test/Semantics/OpenMP/omp-lastprivate01.f90
+++ b/flang/test/Semantics/OpenMP/omp-lastprivate01.f90
@@ -16,6 +16,7 @@ program omp_lastprivate
b = 20
!ERROR: Variable 'k' on the LASTPRIVATE clause is not definable
+ !BECAUSE: 'k' is not a variable
!$omp parallel do lastprivate(k)
do i = 1, 10
c(i) = a(i) + b(i) + k
@@ -23,6 +24,7 @@ program omp_lastprivate
!$omp end parallel do
!ERROR: Variable 'p' on the LASTPRIVATE clause is not definable
+ !BECAUSE: 'p' is protected in this scope
!$omp parallel do lastprivate(p)
do i = 1, 10
c(i) = a(i) + b(i) + k
@@ -43,6 +45,7 @@ subroutine omp_lastprivate_sb(m)
b = 20
!ERROR: Variable 'm' on the LASTPRIVATE clause is not definable
+ !BECAUSE: 'm' is an INTENT(IN) dummy argument
!$omp parallel do lastprivate(m)
do i = 1, 10
c(i) = a(i) + b(i) + m
diff --git a/flang/test/Semantics/OpenMP/omp-reduction04.f90 b/flang/test/Semantics/OpenMP/omp-reduction04.f90
index 4f089322c538e..319ed9f245abe 100644
--- a/flang/test/Semantics/OpenMP/omp-reduction04.f90
+++ b/flang/test/Semantics/OpenMP/omp-reduction04.f90
@@ -7,6 +7,7 @@ program omp_Reduction
common /c/ a, b
!ERROR: Variable 'k' on the REDUCTION clause is not definable
+ !BECAUSE: 'k' is not a variable
!$omp parallel do reduction(+:k)
do i = 1, 10
l = k + 1
@@ -14,6 +15,7 @@ program omp_Reduction
!$omp end parallel do
!ERROR: Variable 'c' on the REDUCTION clause is not definable
+ !BECAUSE: 'c' is not a variable
!$omp parallel do reduction(*:/c/)
do i = 1, 10
l = k + 1
diff --git a/flang/test/Semantics/assign02.f90 b/flang/test/Semantics/assign02.f90
index 4a0b372342193..707d5ed3cfaa5 100644
--- a/flang/test/Semantics/assign02.f90
+++ b/flang/test/Semantics/assign02.f90
@@ -95,10 +95,12 @@ subroutine s6
real :: b
end type
type(tp) :: y
- !ERROR: 'p' is not a pointer
+ !ERROR: The left-hand side of a pointer assignment is not definable
+ !BECAUSE: 'p' is not a pointer
p => x
y%a => x
- !ERROR: 'b' is not a pointer
+ !ERROR: The left-hand side of a pointer assignment is not definable
+ !BECAUSE: 'b' is not a pointer
y%b => x
end
diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index 07e2c49008700..ccea6bb2f7b39 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -17,7 +17,8 @@ subroutine s1
type(t), allocatable :: a(:)
type(t), allocatable :: b[:]
a(1)%p => s
- !ERROR: Procedure pointer may not be a coindexed object
+ !ERROR: The left-hand side of a pointer assignment is not definable
+ !BECAUSE: Procedure pointer 'p' may not be a coindexed object
b[1]%p => s
end
! C1028
diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index a34d5987ad42f..f1ec238db835a 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -22,11 +22,14 @@ subroutine s2(x)
!ERROR: Assignment to constant 'x' is not allowed
x = 2.0
i = 2
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'a' is not a variable
a(i) = 3.0
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'a' is not a variable
a(i:i+1) = [4, 5]
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'c' is not a variable
c(i:2) = "cd"
end
@@ -40,7 +43,8 @@ subroutine s3
type(t), parameter :: y = t([1,2], 3)
integer :: i = 1
x%a(i) = 1
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'y' is not a variable
y%a(i) = 2
x%b = 4
!ERROR: Assignment to constant 'y%b' is not allowed
@@ -57,11 +61,14 @@ 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
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'x' is an INTENT(IN) dummy argument
x = y
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'x' is an INTENT(IN) dummy argument
x%a(1) = 2
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'c' is an INTENT(IN) dummy argument
c(2:3) = "ab"
end
end
@@ -80,11 +87,13 @@ subroutine s5()
use m5
implicit none
x = 1.0
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'y' is protected in this scope
y = 2.0
!ERROR: No explicit type declared for 'z'
z = 3.0
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'b' is protected in this scope
b%a = 1.0
end
diff --git a/flang/test/Semantics/atomic02.f90 b/flang/test/Semantics/atomic02.f90
index 4c3a59dda250a..10a7c126dbb6d 100644
--- a/flang/test/Semantics/atomic02.f90
+++ b/flang/test/Semantics/atomic02.f90
@@ -66,7 +66,8 @@ program test_atomic_and
!ERROR: 'stat' argument to 'atomic_and' may not be a coindexed object
call atomic_and(scalar_coarray, val, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_and(scalar_coarray, val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic03.f90 b/flang/test/Semantics/atomic03.f90
index f01e11656c03c..9bb1d1c0df6b1 100644
--- a/flang/test/Semantics/atomic03.f90
+++ b/flang/test/Semantics/atomic03.f90
@@ -178,7 +178,8 @@ program test_atomic_cas
!ERROR: 'stat' argument to 'atomic_cas' may not be a coindexed object
call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, 1)
! missing mandatory arguments
diff --git a/flang/test/Semantics/atomic04.f90 b/flang/test/Semantics/atomic04.f90
index 4ec9f5c36b73c..f065bf6404f1a 100644
--- a/flang/test/Semantics/atomic04.f90
+++ b/flang/test/Semantics/atomic04.f90
@@ -103,7 +103,8 @@ program test_atomic_define
!ERROR: 'stat' argument to 'atomic_define' may not be a coindexed object
call atomic_define(scalar_coarray, val, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_define(scalar_coarray, val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic05.f90 b/flang/test/Semantics/atomic05.f90
index 6c8b707f8f3e1..04c29cdd6046b 100644
--- a/flang/test/Semantics/atomic05.f90
+++ b/flang/test/Semantics/atomic05.f90
@@ -79,7 +79,8 @@ program test_atomic_fetch_add
!ERROR: 'stat' argument to 'atomic_fetch_add' may not be a coindexed object
call atomic_fetch_add(scalar_coarray, val, old_val, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_fetch_add(scalar_coarray, val, old_val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic06.f90 b/flang/test/Semantics/atomic06.f90
index c54cd85c8c2be..e6307d129262e 100644
--- a/flang/test/Semantics/atomic06.f90
+++ b/flang/test/Semantics/atomic06.f90
@@ -79,7 +79,8 @@ program test_atomic_fetch_and
!ERROR: 'stat' argument to 'atomic_fetch_and' may not be a coindexed object
call atomic_fetch_and(scalar_coarray, val, old_val, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_fetch_and(scalar_coarray, val, old_val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic07.f90 b/flang/test/Semantics/atomic07.f90
index 14cf1222a6592..0ac7ad152e86b 100644
--- a/flang/test/Semantics/atomic07.f90
+++ b/flang/test/Semantics/atomic07.f90
@@ -75,7 +75,8 @@ program test_atomic_fetch_or
!ERROR: 'stat' argument to 'atomic_fetch_or' may not be a coindexed object
call atomic_fetch_or(scalar_coarray[1], val_coarray[1], old_val_coarray[1], coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_fetch_or(scalar_coarray, val, old_val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic08.f90 b/flang/test/Semantics/atomic08.f90
index 8d4110c9acfd5..a08512f1c7fe8 100644
--- a/flang/test/Semantics/atomic08.f90
+++ b/flang/test/Semantics/atomic08.f90
@@ -79,7 +79,8 @@ program test_atomic_fetch_xor
!ERROR: 'stat' argument to 'atomic_fetch_xor' may not be a coindexed object
call atomic_fetch_xor(scalar_coarray, val, old_val, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_fetch_xor(scalar_coarray, val, old_val, 1)
!ERROR: missing mandatory 'atom=' argument
diff --git a/flang/test/Semantics/atomic10.f90 b/flang/test/Semantics/atomic10.f90
index 848b0175c7af2..46fcf537f1810 100644
--- a/flang/test/Semantics/atomic10.f90
+++ b/flang/test/Semantics/atomic10.f90
@@ -103,7 +103,8 @@ program test_atomic_ref
!ERROR: 'stat' argument to 'atomic_ref' may not be a coindexed object
call atomic_ref(val, scalar_coarray, coindexed_status[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '1_4' is not a variable or pointer
call atomic_ref(val, scalar_coarray, 1)
!ERROR: missing mandatory 'value=' argument
diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90
index ad98e4e629ae2..a34394cccb8ae 100644
--- a/flang/test/Semantics/call03.f90
+++ b/flang/test/Semantics/call03.f90
@@ -252,27 +252,37 @@ subroutine test11(in) ! C15.5.2.4(20)
real, intent(in) :: in
real :: x
x = 0.
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'in' is an INTENT(IN) dummy argument
call intentout(in)
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
call intentout(3.14159)
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'in+1._4' is not a variable or pointer
call intentout(in + 1.)
call intentout(x) ! ok
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: '(x)' is not a variable or pointer
call intentout((x))
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call system_clock(count=2)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'in' is an INTENT(IN) dummy argument
call intentinout(in)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
call intentinout(3.14159)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'in+1._4' is not a variable or pointer
call intentinout(in + 1.)
call intentinout(x) ! ok
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: '(x)' is not a variable or pointer
call intentinout((x))
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
+ !BECAUSE: '0_4' is not a variable or pointer
call execute_command_line(command="echo hello", exitstat=0)
end subroutine
@@ -280,9 +290,11 @@ subroutine test12 ! 15.5.2.4(21)
real :: a(1)
integer :: j(1)
j(1) = 1
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
call intentout_arr(a(j))
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
call intentinout_arr(a(j))
call asynchronous_arr(a(j)) ! ok
call volatile_arr(a(j)) ! ok
diff --git a/flang/test/Semantics/call06.f90 b/flang/test/Semantics/call06.f90
index 1f4b17fed5fda..3e3c5aa61b570 100644
--- a/flang/test/Semantics/call06.f90
+++ b/flang/test/Semantics/call06.f90
@@ -48,9 +48,11 @@ subroutine test(x)
call s04(cov[1]) ! ok
!ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument
call s01(cov[1])
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'x' is an INTENT(IN) dummy argument
call s05(x)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'x' is an INTENT(IN) dummy argument
call s06(x)
end subroutine
end module
diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90
index c1a0eb561cf28..f46753a7b69a9 100644
--- a/flang/test/Semantics/call10.f90
+++ b/flang/test/Semantics/call10.f90
@@ -160,7 +160,8 @@ pure subroutine s11(to) ! C1596
!ERROR: Deallocation of polymorphic object 'auto%a' is not permitted in a pure subprogram
type(polyAlloc) :: auto
type(polyAlloc), intent(in out) :: to
- !ERROR: Deallocation of polymorphic non-coarray component '%a' is not permitted in a pure subprogram
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'to' has polymorphic non-coarray component '%a' in a pure subprogram
to = auto
end subroutine
pure subroutine s12
diff --git a/flang/test/Semantics/call12.f90 b/flang/test/Semantics/call12.f90
index 8548958facca4..8ba42c16d4fe6 100644
--- a/flang/test/Semantics/call12.f90
+++ b/flang/test/Semantics/call12.f90
@@ -38,21 +38,29 @@ pure function test(ptr, in, hpd)
integer :: n
common /block/ y
external :: extfunc
- !ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'x' may not be defined in pure subprogram 'test' because it is host-associated
x%a = 0.
- !ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'y' may not be defined in pure subprogram 'test' because it is in a COMMON block
y%a = 0. ! C1594(1)
- !ERROR: Pure subprogram 'test' may not define 'useassociated' because it is USE-associated
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'useassociated' may not be defined in pure subprogram 'test' because it is USE-associated
useassociated = 0. ! C1594(1)
- !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
ptr%a = 0. ! C1594(1)
- !ERROR: Pure subprogram 'test' may not define 'in' because it is an INTENT(IN) dummy argument
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'in' is an INTENT(IN) dummy argument
in%a = 0. ! C1594(1)
- !ERROR: A pure subprogram may not define a coindexed object
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: A pure subprogram may not define the coindexed object 'hcp%co[1_8]'
hcp%co[1] = 0. ! C1594(1)
- !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+ !ERROR: The left-hand side of a pointer assignment is not definable
+ !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
ptr => z ! C1594(2)
- !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+ !ERROR: 'ptr' may not appear in NULLIFY
+ !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
nullify(ptr) ! C1594(2), 19.6.8
!ERROR: A pure subprogram may not use 'ptr' as the target of pointer assignment because it is a POINTER dummy argument of a pure function
ptr2 => ptr ! C1594(3)
@@ -77,7 +85,8 @@ pure function test(ptr, in, hpd)
contains
pure subroutine internal
type(hasPtr) :: localhp
- !ERROR: Pure subprogram 'internal' may not define 'z' because it is host-associated
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'z' may not be defined in pure subprogram 'internal' because it is host-associated
z%a = 0.
!ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
localhp = hasPtr(z%a)
diff --git a/flang/test/Semantics/collectives01.f90 b/flang/test/Semantics/collectives01.f90
index e0c7a3688bfe2..c87e228508e15 100644
--- a/flang/test/Semantics/collectives01.f90
+++ b/flang/test/Semantics/collectives01.f90
@@ -85,7 +85,8 @@ program test_co_sum
call co_sum(bool)
! argument 'a' is intent(inout)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_sum(a=1+1)
!ERROR: 'a' argument to 'co_sum' may not be a coindexed object
@@ -100,7 +101,8 @@ program test_co_sum
call co_sum(c, result_image=integer_array)
! argument 'stat' shall be intent(out)
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_sum(a=i, result_image=1, stat=1+1, errmsg=message)
!ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
@@ -118,7 +120,8 @@ program test_co_sum
call co_sum(i, stat=integer_array)
! 'errmsg' argument shall be intent(inout)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+ !BECAUSE: '"c"' is not a variable or pointer
call co_sum(a=i, result_image=1, stat=status, errmsg='c')
!ERROR: 'errmsg' argument to 'co_sum' may not be a coindexed object
diff --git a/flang/test/Semantics/collectives02.f90 b/flang/test/Semantics/collectives02.f90
index 2810fd474d887..96485ce2ebae6 100644
--- a/flang/test/Semantics/collectives02.f90
+++ b/flang/test/Semantics/collectives02.f90
@@ -83,7 +83,8 @@ program test_co_min
!ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
call co_min(complex_type)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_min(a=1+1)
!ERROR: 'a' argument to 'co_min' may not be a coindexed object
@@ -105,7 +106,8 @@ program test_co_min
!ERROR: 'stat=' argument has unacceptable rank 1
call co_min(i, stat=integer_array)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+ !BECAUSE: '"c"' is not a variable or pointer
call co_min(a=i, result_image=1, stat=status, errmsg='c')
!ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
diff --git a/flang/test/Semantics/collectives03.f90 b/flang/test/Semantics/collectives03.f90
index 9fee04accec5c..e5de68b99bef0 100644
--- a/flang/test/Semantics/collectives03.f90
+++ b/flang/test/Semantics/collectives03.f90
@@ -83,7 +83,8 @@ program test_co_max
!ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
call co_max(complex_type)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_max(a=1+1)
!ERROR: 'a' argument to 'co_max' may not be a coindexed object
@@ -105,7 +106,8 @@ program test_co_max
!ERROR: 'stat=' argument has unacceptable rank 1
call co_max(i, stat=integer_array)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+ !BECAUSE: '"c"' is not a variable or pointer
call co_max(a=i, result_image=1, stat=status, errmsg='c')
!ERROR: 'errmsg' argument to 'co_max' may not be a coindexed object
diff --git a/flang/test/Semantics/collectives04.f90 b/flang/test/Semantics/collectives04.f90
index 37b5b2fcd533b..3cd3c3f422d06 100644
--- a/flang/test/Semantics/collectives04.f90
+++ b/flang/test/Semantics/collectives04.f90
@@ -79,7 +79,8 @@ program test_co_broadcast
!ERROR: missing mandatory 'source_image=' argument
call co_broadcast(a=c, stat=status, errmsg=message)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_broadcast(a=1+1, source_image=1)
!ERROR: 'a' argument to 'co_broadcast' may not be a coindexed object
@@ -93,7 +94,8 @@ program test_co_broadcast
!ERROR: 'source_image=' argument has unacceptable rank 1
call co_broadcast(c, source_image=integer_array)
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+ !BECAUSE: '2_4' is not a variable or pointer
call co_broadcast(a=i, source_image=1, stat=1+1, errmsg=message)
!ERROR: 'stat' argument to 'co_broadcast' may not be a coindexed object
@@ -106,7 +108,8 @@ program test_co_broadcast
!ERROR: 'stat=' argument has unacceptable rank 1
call co_broadcast(i, stat=integer_array, source_image=1)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+ !BECAUSE: '"c"' is not a variable or pointer
call co_broadcast(a=i, source_image=1, stat=status, errmsg='c')
!ERROR: 'errmsg' argument to 'co_broadcast' may not be a coindexed object
diff --git a/flang/test/Semantics/deallocate05.f90 b/flang/test/Semantics/deallocate05.f90
index 0363a1f9a6b85..7d58350bdd286 100644
--- a/flang/test/Semantics/deallocate05.f90
+++ b/flang/test/Semantics/deallocate05.f90
@@ -57,7 +57,8 @@ Program deallocatetest
!ERROR: STAT may not be duplicated in a DEALLOCATE statement
Deallocate(x, stat=s, stat=s)
-!ERROR: STAT variable 'const_s' must be definable
+!ERROR: STAT variable 'const_s' is not definable
+!BECAUSE: '13_4' is not a variable or pointer
Deallocate(x, stat=const_s)
!ERROR: ERRMSG may not be duplicated in a DEALLOCATE statement
Deallocate(x, errmsg=ee, errmsg=ee)
diff --git a/flang/test/Semantics/io01.f90 b/flang/test/Semantics/io01.f90
index d3d2df1cdb1a8..d536e16648a33 100644
--- a/flang/test/Semantics/io01.f90
+++ b/flang/test/Semantics/io01.f90
@@ -75,7 +75,8 @@
!ERROR: If NEWUNIT appears, FILE or STATUS must also appear
open(newunit=n, newunit=nn, iostat=stat4)
- !ERROR: NEWUNIT variable 'const_new_unit' must be definable
+ !ERROR: NEWUNIT variable 'const_new_unit' is not definable
+ !BECAUSE: '66_4' is not a variable or pointer
open(newunit=const_new_unit, status=cc)
!ERROR: Duplicate UNIT specifier
diff --git a/flang/test/Semantics/io02.f90 b/flang/test/Semantics/io02.f90
index 7571aac659a67..bbcf18e9326b3 100644
--- a/flang/test/Semantics/io02.f90
+++ b/flang/test/Semantics/io02.f90
@@ -32,7 +32,8 @@
!Ok: trailing spaces ignored
close(status='keep ', unit=17)
- !ERROR: IOSTAT variable 'const_stat' must be definable
+ !ERROR: IOSTAT variable 'const_stat' is not definable
+ !BECAUSE: '6666_4' is not a variable or pointer
close(14, iostat=const_stat)
9 continue
diff --git a/flang/test/Semantics/io03.f90 b/flang/test/Semantics/io03.f90
index 45255d6415c31..a5adafd5f2f96 100644
--- a/flang/test/Semantics/io03.f90
+++ b/flang/test/Semantics/io03.f90
@@ -7,7 +7,7 @@
character(20) advance
character(20) :: cvar;
character, parameter :: const_internal_file = "(I6)"
- character, parameter :: const_cvar = "Ceci n'est pas une pipe."
+ character, parameter :: const_cvar*(*) = "Ceci n'est pas une pipe."
integer*1 stat1
integer*2 stat2, id2
integer*8 stat8
@@ -61,16 +61,20 @@
!ERROR: Internal file must not have a vector subscript
read(internal_fileA(vv), *) jj
- !ERROR: Input variable 'const_int' must be definable
+ !ERROR: Input variable 'const_int' is not definable
+ !BECAUSE: '15_4' is not a variable or pointer
read(11, *) const_int
- !ERROR: SIZE variable 'const_size' must be definable
+ !ERROR: SIZE variable 'const_size' is not definable
+ !BECAUSE: '13_4' is not a variable or pointer
read(11, pos=ipos, size=const_size, end=9)
- !ERROR: Input variable 'const_cvar' must be definable
+ !ERROR: Input variable 'const_cvar' is not definable
+ !BECAUSE: '"Ceci n'est pas une pipe."' is not a variable or pointer
read(11, *) const_cvar
- !ERROR: Input variable 'const_cvar' must be definable
+ !ERROR: Input variable 'const_cvar(3:13)' is not definable
+ !BECAUSE: '"ci n'est pa"' is not a variable or pointer
read(11, *) const_cvar(3:13)
!ERROR: Duplicate IOSTAT specifier
@@ -172,7 +176,8 @@ subroutine s(aa, n)
read(*, *) aa(n:n+2,2)
read(*, *) qq(2:5)%y
- !ERROR: Input variable 'n' must be definable
+ !ERROR: Input variable 'n' is not definable
+ !BECAUSE: 'n' is an INTENT(IN) dummy argument
read(*, *) n
!ERROR: Whole assumed-size array 'aa' may not appear here without subscripts
diff --git a/flang/test/Semantics/io04.f90 b/flang/test/Semantics/io04.f90
index 77e1bb6286f54..92601193365c4 100644
--- a/flang/test/Semantics/io04.f90
+++ b/flang/test/Semantics/io04.f90
@@ -2,7 +2,7 @@
character(kind=1,len=50) internal_file
character(kind=1,len=100) msg
character(20) sign
- character, parameter :: const_internal_file = "(I6)"
+ character, parameter :: const_internal_file*(*) = "(I6)"
integer*1 stat1, id1
integer*2 stat2
integer*4 stat4
@@ -69,7 +69,8 @@
!ERROR: If NML appears, a data list must not appear
write(10, nnn, rec=40, fmt=1) 'Ok'
- !ERROR: Internal file variable 'const_internal_file' must be definable
+ !ERROR: Internal file variable 'const_internal_file' is not definable
+ !BECAUSE: '"(I6)"' is not a variable or pointer
write(const_internal_file, fmt=*)
!ERROR: If UNIT=* appears, POS must not appear
@@ -127,7 +128,8 @@
!ERROR: ID kind (1) is smaller than default INTEGER kind (4)
write(id=id1, unit=10, asynchronous='Yes') 'Ok'
- !ERROR: ID variable 'const_id' must be definable
+ !ERROR: ID variable 'const_id' is not definable
+ !BECAUSE: '66666_4' is not a variable or pointer
write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'
write(*, '(X)')
diff --git a/flang/test/Semantics/io05.f90 b/flang/test/Semantics/io05.f90
index 851ec5fee1114..8480ea4b784c2 100644
--- a/flang/test/Semantics/io05.f90
+++ b/flang/test/Semantics/io05.f90
@@ -60,7 +60,8 @@
!ERROR: If ID appears, PENDING must also appear
inquire(file='abc', id=id)
- !ERROR: ROUND variable 'const_round' must be definable
+ !ERROR: ROUND variable 'const_round' is not definable
+ !BECAUSE: '"c"' is not a variable or pointer
inquire(file='abc', round=const_round)
9 continue
diff --git a/flang/test/Semantics/io06.f90 b/flang/test/Semantics/io06.f90
index e3bc7602a66a3..ba73187e829f1 100644
--- a/flang/test/Semantics/io06.f90
+++ b/flang/test/Semantics/io06.f90
@@ -29,7 +29,8 @@
!ERROR: Duplicate IOSTAT specifier
endfile(iostat=stat2, err=9, unit=10, iostat=stat8, iomsg=msg1)
- !ERROR: IOMSG variable 'const_msg' must be definable
+ !ERROR: IOMSG variable 'const_msg' is not definable
+ !BECAUSE: '"d"' is not a variable or pointer
flush(iomsg=const_msg, unit=10, iostat=stat8, err=9)
!ERROR: REWIND statement must have a UNIT number specifier
diff --git a/flang/test/Semantics/modifiable01.f90 b/flang/test/Semantics/modifiable01.f90
index fc5b749f857a6..d6babc8735984 100644
--- a/flang/test/Semantics/modifiable01.f90
+++ b/flang/test/Semantics/modifiable01.f90
@@ -33,38 +33,38 @@ subroutine test1(dummy)
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
+ !CHECK: error: Input variable 'a' is not definable
+ !CHECK: because: '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: Construct association has a vector subscript
+ !CHECK: error: Input variable 'a' is not definable
+ !CHECK: because: Construct association 'a' has a vector subscript
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: '666_4' is not a variable
+ !CHECK: error: Input variable 'j3' is not definable
+ !CHECK: because: '666_4' 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
+ !CHECK: error: Left-hand side of assignment is not definable
+ !CHECK: because: '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
+ !CHECK: error: Left-hand side of assignment is not definable
+ !CHECK: because: '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
+ !CHECK: error: Left-hand side of assignment is not definable
+ !CHECK: because: '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
+ !CHECK: error: Input variable 'ptr' is not definable
+ !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
read(internal,*) ptr
end subroutine
end module
diff --git a/flang/test/Semantics/nullify02.f90 b/flang/test/Semantics/nullify02.f90
index 09eab7902a553..4e98d9e15f96a 100644
--- a/flang/test/Semantics/nullify02.f90
+++ b/flang/test/Semantics/nullify02.f90
@@ -16,16 +16,20 @@
Procedure(Real) :: prp
Allocate(x(3))
-!ERROR: component in NULLIFY statement must have the POINTER attribute
+!ERROR: 'p' may not appear in NULLIFY
+!BECAUSE: 'p' is not a pointer
Nullify(x(2)%p)
-!ERROR: name in NULLIFY statement must have the POINTER attribute
+!ERROR: 'pi' may not appear in NULLIFY
+!BECAUSE: 'pi' is not a pointer
Nullify(pi)
-!ERROR: name in NULLIFY statement must be a variable or procedure pointer
+!ERROR: 'prp' may not appear in NULLIFY
+!BECAUSE: 'prp' is not a pointer
Nullify(prp)
-!ERROR: name in NULLIFY statement must be a variable or procedure pointer
+!ERROR: 'maxvalue' may not appear in NULLIFY
+!BECAUSE: 'maxvalue' is not a pointer
Nullify(maxvalue)
End Program
@@ -45,7 +49,8 @@ module function ptrFun()
integer, pointer :: ptrFun
real :: realVar
nullify(ptrFun)
- !ERROR: name in NULLIFY statement must have the POINTER attribute
+ !ERROR: 'realvar' may not appear in NULLIFY
+ !BECAUSE: 'realvar' is not a pointer
nullify(realVar)
end function
end module
diff --git a/flang/test/Semantics/random-seed.f90 b/flang/test/Semantics/random-seed.f90
index 20e3088c5e828..9ad2a2544bedf 100644
--- a/flang/test/Semantics/random-seed.f90
+++ b/flang/test/Semantics/random-seed.f90
@@ -10,7 +10,8 @@ program test_random_seed
call random_seed()
call random_seed(size_arg)
call random_seed(size=size_arg)
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'size=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'size=' is not definable
+ !BECAUSE: '343_4' is not a variable or pointer
call random_seed(size_arg_const) ! error, size arg must be definable
!ERROR: 'size=' argument has unacceptable rank 1
call random_seed([1, 2, 3, 4]) ! Error, must be a scalar
@@ -21,7 +22,8 @@ program test_random_seed
call random_seed(get=get_arg)
!ERROR: 'get=' argument has unacceptable rank 0
call random_seed(get=get_arg_scalar) ! Error, GET arg must be of rank 1
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'get=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'get=' is not definable
+ !BECAUSE: '[INTEGER(4)::8_4,7_4,6_4]' is not a variable or pointer
call random_seed(get=get_arg_const) ! Error, GET arg must be definable
!ERROR: RANDOM_SEED must have either 1 or no arguments
call random_seed(size_arg, get_arg) ! Error, only 0 or 1 argument
diff --git a/flang/test/Semantics/resolve35.f90 b/flang/test/Semantics/resolve35.f90
index 46a3a92c7c83a..17034ebc2f0f3 100644
--- a/flang/test/Semantics/resolve35.f90
+++ b/flang/test/Semantics/resolve35.f90
@@ -111,12 +111,16 @@ subroutine s10
x = cos(0.)
do concurrent(i=1:2) &
!ERROR: 'bad1' may not appear in a locality-spec because it is not definable
+ !BECAUSE: 'bad1' is not a variable
local(bad1) &
!ERROR: 'bad2' may not appear in a locality-spec because it is not definable
+ !BECAUSE: 'bad2' is not a variable
local(bad2) &
!ERROR: 'bad3' may not appear in a locality-spec because it is not definable
+ !BECAUSE: 'bad3' is not a variable
local(bad3) &
!ERROR: 'cos' may not appear in a locality-spec because it is not definable
+ !BECAUSE: 'cos' is not a variable
local(cos)
end do
do concurrent(i=1:2) &
diff --git a/flang/test/Semantics/resolve57.f90 b/flang/test/Semantics/resolve57.f90
index 6fa698c4cfbbe..aa0ae45c8216f 100644
--- a/flang/test/Semantics/resolve57.f90
+++ b/flang/test/Semantics/resolve57.f90
@@ -40,6 +40,7 @@ subroutine s4()
! C857 This is not OK because of the "protected" attribute
!ERROR: 'prot' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'prot' is protected in this scope
do concurrent (i=1:5) local(prot)
end do
@@ -59,6 +60,7 @@ subroutine s5()
! C1101 This is not OK because 'a' is not associated with a variable
!ERROR: 'a' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'a' is construct associated with an expression
do concurrent (i=1:5) local(a)
end do
end associate
@@ -95,6 +97,7 @@ subroutine s6()
type is ( point )
! C1158 This is not OK because 'a' is not associated with a variable
!ERROR: 'a' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'a' is construct associated with an expression
do concurrent (i=1:5) local(a)
end do
end select
@@ -116,6 +119,7 @@ pure subroutine s7()
! C1594 This is not OK because we're in a PURE subroutine
!ERROR: 'var' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'var' may not be defined in pure subprogram 's7' because it is USE-associated
do concurrent (i=1:5) local(var)
end do
end subroutine s7
@@ -124,6 +128,7 @@ subroutine s8()
integer, parameter :: iconst = 343
!ERROR: 'iconst' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'iconst' is not a variable
do concurrent (i=1:5) local(iconst)
end do
end subroutine s8
diff --git a/flang/test/Semantics/resolve62.f90 b/flang/test/Semantics/resolve62.f90
index ef565dd01d6c5..e7d5cd9bd221d 100644
--- a/flang/test/Semantics/resolve62.f90
+++ b/flang/test/Semantics/resolve62.f90
@@ -69,11 +69,13 @@ subroutine s4a
end
subroutine s4b
use m4
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'x' is protected in this scope
call s(x)
end
pure subroutine s4c
use m4
- !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'y' may not be defined in pure subprogram 's4c' because it is USE-associated
call s(y)
end
diff --git a/flang/test/Semantics/resolve76.f90 b/flang/test/Semantics/resolve76.f90
index 6b182d1d57906..ac0aff98b345e 100644
--- a/flang/test/Semantics/resolve76.f90
+++ b/flang/test/Semantics/resolve76.f90
@@ -16,7 +16,8 @@ logical module function f()
submodule(m1) sm1
contains
module procedure sub1
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'a' is an INTENT(IN) dummy argument
a = 1.0
b = 2.0
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types REAL(4) and LOGICAL(4)
diff --git a/flang/test/Semantics/selecttype03.f90 b/flang/test/Semantics/selecttype03.f90
index f7070f7bb0d60..eb343c4ccc530 100644
--- a/flang/test/Semantics/selecttype03.f90
+++ b/flang/test/Semantics/selecttype03.f90
@@ -37,10 +37,12 @@
select type ( y => (fun(1)) )
type is (t1)
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'y' is construct associated with an expression
y%i = 1 !VDC
type is (t2)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+ !BECAUSE: 'y' is construct associated with an expression
call sub_with_in_and_inout_param(y,y) !VDC
end select
@@ -58,18 +60,22 @@
!C)Associate with with vector subscript
select type (b => array1(V,2))
type is (t1)
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: Construct association 'b' has a vector subscript
b%i = 1 !VDC
type is (t2)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+ !BECAUSE: Variable 'b' has a vector subscript
call sub_with_in_and_inout_param_vector(b,b) !VDC
end select
select type(b => foo(1) )
type is (t1)
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Left-hand side of assignment is not definable
+ !BECAUSE: 'b' is construct associated with an expression
b%i = 1 !VDC
type is (t2)
- !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+ !BECAUSE: 'b' is construct associated with an expression
call sub_with_in_and_inout_param_vector(b,b) !VDC
end select
More information about the flang-commits
mailing list