[flang-commits] [flang] [flang] Downgrade error message to a portability warning (PR #98368)
via flang-commits
flang-commits at lists.llvm.org
Wed Jul 10 11:58:20 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
f18 current emits an error when an assignment is made to an array section with a vector subscript, and the array is finalized with a non-elemental final subroutine. Some other compilers emit this error because (I think) they want variables to only be finalized in place, not by a subroutine call involving copy-in & copy-out of the finalized elements.
Since many other Fortran compilers can handle this case, and there's nothing in the standards to preclude it, let's downgrade this error message to a portability warning.
This patch got complicated because the API for the WhyNotDefinable() utility routine was such that it would return a message only in error cases, and there was no provision for returning non-fatal messages. It now returns either nothing, a fatal message, or a non-fatal warning message, and all of its call sites have been modified to cope.
---
Patch is 24.70 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/98368.diff
16 Files Affected:
- (modified) flang/include/flang/Common/Fortran-features.h (+3-1)
- (modified) flang/lib/Semantics/assignment.cpp (+8-3)
- (modified) flang/lib/Semantics/check-allocate.cpp (+1-1)
- (modified) flang/lib/Semantics/check-call.cpp (+16-6)
- (modified) flang/lib/Semantics/check-deallocate.cpp (+8-4)
- (modified) flang/lib/Semantics/check-declarations.cpp (+1-1)
- (modified) flang/lib/Semantics/check-do-forall.cpp (+1-1)
- (modified) flang/lib/Semantics/check-io.cpp (+11-6)
- (modified) flang/lib/Semantics/check-nullify.cpp (+4-2)
- (modified) flang/lib/Semantics/check-omp-structure.cpp (+2-2)
- (modified) flang/lib/Semantics/definable.cpp (+48-35)
- (modified) flang/lib/Semantics/definable.h (+3-2)
- (modified) flang/lib/Semantics/pointer-assignment.cpp (+3-2)
- (modified) flang/lib/Semantics/resolve-names.cpp (+1-1)
- (modified) flang/test/Semantics/definable02.f90 (+3-5)
- (modified) flang/test/Semantics/final03.f90 (+2-3)
``````````diff
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 53262940945ad..7346d702b073d 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -69,7 +69,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
IgnoredDirective, HomonymousSpecific, HomonymousResult,
IgnoredIntrinsicFunctionType, PreviousScalarUse,
RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition,
- IncompatibleImplicitInterfaces, BadTypeForTarget)
+ IncompatibleImplicitInterfaces, BadTypeForTarget,
+ VectorSubscriptFinalization)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
@@ -142,6 +143,7 @@ class LanguageFeatureControl {
warnUsage_.set(UsageWarning::IndexVarRedefinition);
warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
warnUsage_.set(UsageWarning::BadTypeForTarget);
+ warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
}
LanguageFeatureControl(const LanguageFeatureControl &) = default;
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index ef53e25bd1c52..e69a73c7837ce 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -68,9 +68,14 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
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));
+ if (whyNot->IsFatal()) {
+ if (auto *msg{Say(lhsLoc,
+ "Left-hand side of assignment is not definable"_err_en_US)}) {
+ msg->Attach(
+ std::move(whyNot->set_severity(parser::Severity::Because)));
+ }
+ } else {
+ context_.Say(std::move(*whyNot));
}
}
auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index a4fa72b03ca18..e344390372c12 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -607,7 +607,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
context
.Say(name_.source,
"Name in ALLOCATE statement is not definable"_err_en_US)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(whyNot->set_severity(parser::Severity::Because)));
return false;
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 8fe90eedc913f..ef51b9a0d0ce3 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -679,9 +679,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
flags.set(DefinabilityFlag::PointerDefinition);
}
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
- if (auto *msg{
- messages.Say(std::move(*undefinableMessage), dummyName)}) {
- msg->Attach(std::move(*whyNot));
+ if (whyNot->IsFatal()) {
+ if (auto *msg{
+ messages.Say(std::move(*undefinableMessage), dummyName)}) {
+ msg->Attach(
+ std::move(whyNot->set_severity(parser::Severity::Because)));
+ }
+ } else {
+ messages.Say(std::move(*whyNot));
}
}
}
@@ -1413,9 +1418,14 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
*scope,
DefinabilityFlags{DefinabilityFlag::PointerDefinition},
*pointerExpr)}) {
- if (auto *msg{messages.Say(pointerArg->sourceLocation(),
- "POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement"_port_en_US)}) {
- msg->Attach(std::move(*whyNot));
+ if (whyNot->IsFatal()) {
+ if (auto *msg{messages.Say(pointerArg->sourceLocation(),
+ "POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement"_port_en_US)}) {
+ msg->Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
+ }
+ } else {
+ messages.Say(std::move(*whyNot));
}
}
}
diff --git a/flang/lib/Semantics/check-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp
index 798c580265609..7cac1c413b643 100644
--- a/flang/lib/Semantics/check-deallocate.cpp
+++ b/flang/lib/Semantics/check-deallocate.cpp
@@ -43,7 +43,8 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
context_
.Say(name.source,
"Name in DEALLOCATE statement is not definable"_err_en_US)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
} else if (auto whyNot{WhyNotDefinable(name.source,
context_.FindScope(name.source),
DefinabilityFlags{}, *symbol)}) {
@@ -51,7 +52,8 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
context_
.Say(name.source,
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
} else {
context_.CheckIndexVarRedefine(name);
}
@@ -77,14 +79,16 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
context_
.Say(source,
"Name in DEALLOCATE statement is not definable"_err_en_US)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
} else if (auto whyNot{WhyNotDefinable(source,
context_.FindScope(source), DefinabilityFlags{},
*expr)}) {
context_
.Say(source,
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
}
}
},
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index dae4050279200..a733a53d39cbb 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -884,7 +884,7 @@ void CheckHelper::CheckObjectEntity(
if (auto *msg{messages_.Say(
"'%s' may not be a local variable in a pure subprogram"_err_en_US,
symbol.name())}) {
- msg->Attach(std::move(*whyNot));
+ msg->Attach(std::move(whyNot->set_severity(parser::Severity::Because)));
}
}
}
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index 69f8fdafdfeee..34225cd406192 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -505,7 +505,7 @@ class DoContext {
.Say(sourceLocation,
"'%s' may not be used as a DO variable"_err_en_US,
symbol->name())
- .Attach(std::move(*why));
+ .Attach(std::move(why->set_severity(parser::Severity::Because)));
} else {
const DeclTypeSpec *symType{symbol->GetType()};
if (!symType) {
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 8f8a4e800b488..8bde737c4cb94 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -1034,11 +1034,16 @@ void IoChecker::CheckForDefinableVariable(
if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
*expr)}) {
- const Symbol *base{GetFirstSymbol(*expr)};
- context_
- .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
- (base ? base->name() : at).ToString())
- .Attach(std::move(*whyNot));
+ if (whyNot->IsFatal()) {
+ const Symbol *base{GetFirstSymbol(*expr)};
+ context_
+ .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
+ (base ? base->name() : at).ToString())
+ .Attach(
+ std::move(whyNot->set_severity(parser::Severity::Because)));
+ } else {
+ context_.Say(std::move(*whyNot));
+ }
}
}
}
@@ -1191,7 +1196,7 @@ void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
.Say(namelistLocation,
"NAMELIST input group must not contain undefinable item '%s'"_err_en_US,
object.name())
- .Attach(std::move(*why));
+ .Attach(std::move(why->set_severity(parser::Severity::Because)));
context_.SetError(namelist);
}
}
diff --git a/flang/lib/Semantics/check-nullify.cpp b/flang/lib/Semantics/check-nullify.cpp
index a3d353198d1af..452a891fe9bd8 100644
--- a/flang/lib/Semantics/check-nullify.cpp
+++ b/flang/lib/Semantics/check-nullify.cpp
@@ -31,7 +31,8 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
.Say(name.source,
"'%s' may not appear in NULLIFY"_err_en_US,
name.source)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
}
}
},
@@ -44,7 +45,8 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
*checkedExpr)}) {
context_.messages()
.Say(at, "'%s' may not appear in NULLIFY"_err_en_US, at)
- .Attach(std::move(*whyNot));
+ .Attach(std::move(
+ whyNot->set_severity(parser::Severity::Because)));
}
}
},
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index e5baddf599402..24742826280ce 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2564,7 +2564,7 @@ void OmpStructureChecker::CheckIntentInPointerAndDefinable(
"Variable '%s' on the %s clause is not definable"_err_en_US,
symbol->name(),
parser::ToUpperCaseLetters(getClauseName(clause).str()))
- .Attach(std::move(*msg));
+ .Attach(std::move(msg->set_severity(parser::Severity::Because)));
}
}
}
@@ -3369,7 +3369,7 @@ void OmpStructureChecker::CheckDefinableObjects(
"Variable '%s' on the %s clause is not definable"_err_en_US,
symbol->name(),
parser::ToUpperCaseLetters(getClauseName(clause).str()))
- .Attach(std::move(*msg));
+ .Attach(std::move(msg->set_severity(parser::Severity::Because)));
}
}
}
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index 5c3fa905d6072..96af46abd6180 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -18,7 +18,7 @@ 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);
+ message.set_severity(parser::Severity::Error);
evaluate::AttachDeclaration(message, original);
return message;
}
@@ -204,21 +204,19 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
if (auto dyType{evaluate::DynamicType::From(ultimate)}) {
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
if (dyType->IsPolymorphic()) { // C1596
- return BlameSymbol(at,
- "'%s' is polymorphic in a pure subprogram"_because_en_US,
- original);
+ return BlameSymbol(
+ at, "'%s' is polymorphic in a pure subprogram"_en_US, original);
}
}
if (const Symbol * impure{HasImpureFinal(ultimate)}) {
- return BlameSymbol(at,
- "'%s' has an impure FINAL procedure '%s'"_because_en_US, original,
- impure->name());
+ return BlameSymbol(at, "'%s' has an impure FINAL procedure '%s'"_en_US,
+ original, impure->name());
}
if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
return BlameSymbol(at,
- "'%s' has polymorphic component '%s' in a pure subprogram"_because_en_US,
+ "'%s' has polymorphic component '%s' in a pure subprogram"_en_US,
original, bad.BuildResultDesignatorName());
}
}
@@ -232,24 +230,33 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
const Scope &scope, DefinabilityFlags flags,
const evaluate::DataRef &dataRef) {
- if (auto whyNot{
- WhyNotDefinableBase(at, scope, flags, dataRef.GetFirstSymbol(),
- std::holds_alternative<evaluate::SymbolRef>(dataRef.u),
- DefinesComponentPointerTarget(dataRef, flags))}) {
- return whyNot;
- } else {
- return WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol());
+ auto whyNotBase{
+ WhyNotDefinableBase(at, scope, flags, dataRef.GetFirstSymbol(),
+ std::holds_alternative<evaluate::SymbolRef>(dataRef.u),
+ DefinesComponentPointerTarget(dataRef, flags))};
+ if (!whyNotBase || !whyNotBase->IsFatal()) {
+ if (auto whyNotLast{
+ WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol())}) {
+ if (whyNotLast->IsFatal() || !whyNotBase) {
+ return whyNotLast;
+ }
+ }
}
+ return whyNotBase;
}
std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
- if (auto base{WhyNotDefinableBase(at, scope, flags, original,
- /*isWholeSymbol=*/true, /*isComponentPointerTarget=*/false)}) {
- return base;
- } else {
- return WhyNotDefinableLast(at, scope, flags, original);
+ auto whyNotBase{WhyNotDefinableBase(at, scope, flags, original,
+ /*isWholeSymbol=*/true, /*isComponentPointerTarget=*/false)};
+ if (!whyNotBase || !whyNotBase->IsFatal()) {
+ if (auto whyNotLast{WhyNotDefinableLast(at, scope, flags, original)}) {
+ if (whyNotLast->IsFatal() || !whyNotBase) {
+ return whyNotLast;
+ }
+ }
}
+ return whyNotBase;
}
class DuplicatedSubscriptFinder
@@ -296,6 +303,7 @@ class DuplicatedSubscriptFinder
std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
const Scope &scope, DefinabilityFlags flags,
const evaluate::Expr<evaluate::SomeType> &expr) {
+ std::optional<parser::Message> portabilityWarning;
if (auto dataRef{evaluate::ExtractDataRef(expr, true, true)}) {
if (evaluate::HasVectorSubscript(expr)) {
if (flags.test(DefinabilityFlag::VectorSubscriptIsOk)) {
@@ -328,9 +336,14 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
}
}
if (anyRankMatch && !anyElemental) {
- return parser::Message{at,
- "Variable '%s' has a vector subscript and cannot be finalized by non-elemental subroutine '%s'"_because_en_US,
- expr.AsFortran(), anyRankMatch->name()};
+ if (!portabilityWarning &&
+ scope.context().languageFeatures().ShouldWarn(
+ common::UsageWarning::VectorSubscriptFinalization)) {
+ portabilityWarning = parser::Message{at,
+ "Variable '%s' has a vector subscript and will be finalized by non-elemental subroutine '%s'"_port_en_US,
+ expr.AsFortran(), anyRankMatch->name()};
+ }
+ break;
}
const auto *parent{FindParentTypeSpec(*spec)};
spec = parent ? parent->AsDerived() : nullptr;
@@ -340,24 +353,25 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
if (!flags.test(DefinabilityFlag::DuplicatesAreOk) &&
DuplicatedSubscriptFinder{scope.context().foldingContext()}(expr)) {
return parser::Message{at,
- "Variable has a vector subscript with a duplicated element"_because_en_US};
+ "Variable has a vector subscript with a duplicated element"_err_en_US};
}
} else {
return parser::Message{at,
- "Variable '%s' has a vector subscript"_because_en_US,
- expr.AsFortran()};
+ "Variable '%s' has a vector subscript"_err_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,
+ "A pure subprogram may not define the coindexed object '%s'"_err_en_US,
expr.AsFortran());
}
- return WhyNotDefinable(at, scope, flags, *dataRef);
+ if (auto whyNotDataRef{WhyNotDefinable(at, scope, flags, *dataRef)}) {
+ return whyNotDataRef;
+ }
} else if (evaluate::IsNullPointer(expr)) {
return parser::Message{
- at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()};
+ at, "'%s' is a null pointer"_err_en_US, expr.AsFortran()};
} else if (flags.test(DefinabilityFlag::PointerDefinition)) {
if (const auto *procDesignator{
std::get_if<evaluate::ProcedureDesignator>(&expr.u)}) {
@@ -365,7 +379,7 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
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,
+ "Procedure pointer '%s' may not be a coindexed object"_err_en_US,
*procSym, expr.AsFortran());
}
if (const auto *component{procDesignator->GetComponent()}) {
@@ -379,13 +393,12 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
}
}
return parser::Message{
- at, "'%s' is not a definable pointer"_because_en_US, expr.AsFortran()};
+ at, "'%s' is not a definable pointer"_err_en_US, expr.AsFortran()};
} else if (!evaluate::IsVariable(expr)) {
- return parser::Message{at,
- "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
- } else {
- return std::nullopt;
+ return parser::Message{
+ at, "'%s' is not a variable or pointer"_err_en_US, expr.AsFortran()};
}
+ return portabilityWarning;
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h
index df869db25...
[truncated]
``````````
</details>
https://github.com/llvm/llvm-project/pull/98368
More information about the flang-commits
mailing list