Skip to content

Commit d5285fe

Browse files
klauslerklausler
authored
[flang] Downgrade error message to a portability warning (llvm#98368)
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.
1 parent 0b58f34 commit d5285fe

16 files changed

+115
-75
lines changed

‎flang/include/flang/Common/Fortran-features.h

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
6969
IgnoredDirective, HomonymousSpecific, HomonymousResult,
7070
IgnoredIntrinsicFunctionType, PreviousScalarUse,
7171
RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition,
72-
IncompatibleImplicitInterfaces, BadTypeForTarget)
72+
IncompatibleImplicitInterfaces, BadTypeForTarget,
73+
VectorSubscriptFinalization)
7374

7475
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
7576
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
@@ -142,6 +143,7 @@ class LanguageFeatureControl {
142143
warnUsage_.set(UsageWarning::IndexVarRedefinition);
143144
warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
144145
warnUsage_.set(UsageWarning::BadTypeForTarget);
146+
warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
145147
}
146148
LanguageFeatureControl(const LanguageFeatureControl &) = default;
147149

‎flang/lib/Semantics/assignment.cpp

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -68,9 +68,14 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
6868
const Scope &scope{context_.FindScope(lhsLoc)};
6969
if (auto whyNot{WhyNotDefinable(lhsLoc, scope,
7070
DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, lhs)}) {
71-
if (auto *msg{Say(lhsLoc,
72-
"Left-hand side of assignment is not definable"_err_en_US)}) {
73-
msg->Attach(std::move(*whyNot));
71+
if (whyNot->IsFatal()) {
72+
if (auto *msg{Say(lhsLoc,
73+
"Left-hand side of assignment is not definable"_err_en_US)}) {
74+
msg->Attach(
75+
std::move(whyNot->set_severity(parser::Severity::Because)));
76+
}
77+
} else {
78+
context_.Say(std::move(*whyNot));
7479
}
7580
}
7681
auto rhsLoc{std::get<parser::Expr>(stmt.t).source};

‎flang/lib/Semantics/check-allocate.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -607,7 +607,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
607607
context
608608
.Say(name_.source,
609609
"Name in ALLOCATE statement is not definable"_err_en_US)
610-
.Attach(std::move(*whyNot));
610+
.Attach(std::move(whyNot->set_severity(parser::Severity::Because)));
611611
return false;
612612
}
613613
}

‎flang/lib/Semantics/check-call.cpp

Lines changed: 16 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -679,9 +679,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
679679
flags.set(DefinabilityFlag::PointerDefinition);
680680
}
681681
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
682-
if (auto *msg{
683-
messages.Say(std::move(*undefinableMessage), dummyName)}) {
684-
msg->Attach(std::move(*whyNot));
682+
if (whyNot->IsFatal()) {
683+
if (auto *msg{
684+
messages.Say(std::move(*undefinableMessage), dummyName)}) {
685+
msg->Attach(
686+
std::move(whyNot->set_severity(parser::Severity::Because)));
687+
}
688+
} else {
689+
messages.Say(std::move(*whyNot));
685690
}
686691
}
687692
}
@@ -1413,9 +1418,14 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
14131418
*scope,
14141419
DefinabilityFlags{DefinabilityFlag::PointerDefinition},
14151420
*pointerExpr)}) {
1416-
if (auto *msg{messages.Say(pointerArg->sourceLocation(),
1417-
"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)}) {
1418-
msg->Attach(std::move(*whyNot));
1421+
if (whyNot->IsFatal()) {
1422+
if (auto *msg{messages.Say(pointerArg->sourceLocation(),
1423+
"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)}) {
1424+
msg->Attach(std::move(
1425+
whyNot->set_severity(parser::Severity::Because)));
1426+
}
1427+
} else {
1428+
messages.Say(std::move(*whyNot));
14191429
}
14201430
}
14211431
}

‎flang/lib/Semantics/check-deallocate.cpp

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -43,15 +43,17 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
4343
context_
4444
.Say(name.source,
4545
"Name in DEALLOCATE statement is not definable"_err_en_US)
46-
.Attach(std::move(*whyNot));
46+
.Attach(std::move(
47+
whyNot->set_severity(parser::Severity::Because)));
4748
} else if (auto whyNot{WhyNotDefinable(name.source,
4849
context_.FindScope(name.source),
4950
DefinabilityFlags{}, *symbol)}) {
5051
// Catch problems with non-definability of the dynamic object
5152
context_
5253
.Say(name.source,
5354
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
54-
.Attach(std::move(*whyNot));
55+
.Attach(std::move(
56+
whyNot->set_severity(parser::Severity::Because)));
5557
} else {
5658
context_.CheckIndexVarRedefine(name);
5759
}
@@ -77,14 +79,16 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
7779
context_
7880
.Say(source,
7981
"Name in DEALLOCATE statement is not definable"_err_en_US)
80-
.Attach(std::move(*whyNot));
82+
.Attach(std::move(
83+
whyNot->set_severity(parser::Severity::Because)));
8184
} else if (auto whyNot{WhyNotDefinable(source,
8285
context_.FindScope(source), DefinabilityFlags{},
8386
*expr)}) {
8487
context_
8588
.Say(source,
8689
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
87-
.Attach(std::move(*whyNot));
90+
.Attach(std::move(
91+
whyNot->set_severity(parser::Severity::Because)));
8892
}
8993
}
9094
},

‎flang/lib/Semantics/check-declarations.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -884,7 +884,7 @@ void CheckHelper::CheckObjectEntity(
884884
if (auto *msg{messages_.Say(
885885
"'%s' may not be a local variable in a pure subprogram"_err_en_US,
886886
symbol.name())}) {
887-
msg->Attach(std::move(*whyNot));
887+
msg->Attach(std::move(whyNot->set_severity(parser::Severity::Because)));
888888
}
889889
}
890890
}

‎flang/lib/Semantics/check-do-forall.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -505,7 +505,7 @@ class DoContext {
505505
.Say(sourceLocation,
506506
"'%s' may not be used as a DO variable"_err_en_US,
507507
symbol->name())
508-
.Attach(std::move(*why));
508+
.Attach(std::move(why->set_severity(parser::Severity::Because)));
509509
} else {
510510
const DeclTypeSpec *symType{symbol->GetType()};
511511
if (!symType) {

‎flang/lib/Semantics/check-io.cpp

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1034,11 +1034,16 @@ void IoChecker::CheckForDefinableVariable(
10341034
if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
10351035
DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
10361036
*expr)}) {
1037-
const Symbol *base{GetFirstSymbol(*expr)};
1038-
context_
1039-
.Say(at, "%s variable '%s' is not definable"_err_en_US, s,
1040-
(base ? base->name() : at).ToString())
1041-
.Attach(std::move(*whyNot));
1037+
if (whyNot->IsFatal()) {
1038+
const Symbol *base{GetFirstSymbol(*expr)};
1039+
context_
1040+
.Say(at, "%s variable '%s' is not definable"_err_en_US, s,
1041+
(base ? base->name() : at).ToString())
1042+
.Attach(
1043+
std::move(whyNot->set_severity(parser::Severity::Because)));
1044+
} else {
1045+
context_.Say(std::move(*whyNot));
1046+
}
10421047
}
10431048
}
10441049
}
@@ -1191,7 +1196,7 @@ void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
11911196
.Say(namelistLocation,
11921197
"NAMELIST input group must not contain undefinable item '%s'"_err_en_US,
11931198
object.name())
1194-
.Attach(std::move(*why));
1199+
.Attach(std::move(why->set_severity(parser::Severity::Because)));
11951200
context_.SetError(namelist);
11961201
}
11971202
}

‎flang/lib/Semantics/check-nullify.cpp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,8 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
3131
.Say(name.source,
3232
"'%s' may not appear in NULLIFY"_err_en_US,
3333
name.source)
34-
.Attach(std::move(*whyNot));
34+
.Attach(std::move(
35+
whyNot->set_severity(parser::Severity::Because)));
3536
}
3637
}
3738
},
@@ -44,7 +45,8 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
4445
*checkedExpr)}) {
4546
context_.messages()
4647
.Say(at, "'%s' may not appear in NULLIFY"_err_en_US, at)
47-
.Attach(std::move(*whyNot));
48+
.Attach(std::move(
49+
whyNot->set_severity(parser::Severity::Because)));
4850
}
4951
}
5052
},

‎flang/lib/Semantics/check-omp-structure.cpp

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2564,7 +2564,7 @@ void OmpStructureChecker::CheckIntentInPointerAndDefinable(
25642564
"Variable '%s' on the %s clause is not definable"_err_en_US,
25652565
symbol->name(),
25662566
parser::ToUpperCaseLetters(getClauseName(clause).str()))
2567-
.Attach(std::move(*msg));
2567+
.Attach(std::move(msg->set_severity(parser::Severity::Because)));
25682568
}
25692569
}
25702570
}
@@ -3369,7 +3369,7 @@ void OmpStructureChecker::CheckDefinableObjects(
33693369
"Variable '%s' on the %s clause is not definable"_err_en_US,
33703370
symbol->name(),
33713371
parser::ToUpperCaseLetters(getClauseName(clause).str()))
3372-
.Attach(std::move(*msg));
3372+
.Attach(std::move(msg->set_severity(parser::Severity::Because)));
33733373
}
33743374
}
33753375
}

‎flang/lib/Semantics/definable.cpp

Lines changed: 48 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ template <typename... A>
1818
static parser::Message BlameSymbol(parser::CharBlock at,
1919
const parser::MessageFixedText &text, const Symbol &original, A &&...x) {
2020
parser::Message message{at, text, original.name(), std::forward<A>(x)...};
21-
message.set_severity(parser::Severity::Because);
21+
message.set_severity(parser::Severity::Error);
2222
evaluate::AttachDeclaration(message, original);
2323
return message;
2424
}
@@ -204,21 +204,19 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
204204
if (auto dyType{evaluate::DynamicType::From(ultimate)}) {
205205
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
206206
if (dyType->IsPolymorphic()) { // C1596
207-
return BlameSymbol(at,
208-
"'%s' is polymorphic in a pure subprogram"_because_en_US,
209-
original);
207+
return BlameSymbol(
208+
at, "'%s' is polymorphic in a pure subprogram"_en_US, original);
210209
}
211210
}
212211
if (const Symbol * impure{HasImpureFinal(ultimate)}) {
213-
return BlameSymbol(at,
214-
"'%s' has an impure FINAL procedure '%s'"_because_en_US, original,
215-
impure->name());
212+
return BlameSymbol(at, "'%s' has an impure FINAL procedure '%s'"_en_US,
213+
original, impure->name());
216214
}
217215
if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
218216
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
219217
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
220218
return BlameSymbol(at,
221-
"'%s' has polymorphic component '%s' in a pure subprogram"_because_en_US,
219+
"'%s' has polymorphic component '%s' in a pure subprogram"_en_US,
222220
original, bad.BuildResultDesignatorName());
223221
}
224222
}
@@ -232,24 +230,33 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
232230
static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
233231
const Scope &scope, DefinabilityFlags flags,
234232
const evaluate::DataRef &dataRef) {
235-
if (auto whyNot{
236-
WhyNotDefinableBase(at, scope, flags, dataRef.GetFirstSymbol(),
237-
std::holds_alternative<evaluate::SymbolRef>(dataRef.u),
238-
DefinesComponentPointerTarget(dataRef, flags))}) {
239-
return whyNot;
240-
} else {
241-
return WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol());
233+
auto whyNotBase{
234+
WhyNotDefinableBase(at, scope, flags, dataRef.GetFirstSymbol(),
235+
std::holds_alternative<evaluate::SymbolRef>(dataRef.u),
236+
DefinesComponentPointerTarget(dataRef, flags))};
237+
if (!whyNotBase || !whyNotBase->IsFatal()) {
238+
if (auto whyNotLast{
239+
WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol())}) {
240+
if (whyNotLast->IsFatal() || !whyNotBase) {
241+
return whyNotLast;
242+
}
243+
}
242244
}
245+
return whyNotBase;
243246
}
244247

245248
std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
246249
const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
247-
if (auto base{WhyNotDefinableBase(at, scope, flags, original,
248-
/*isWholeSymbol=*/true, /*isComponentPointerTarget=*/false)}) {
249-
return base;
250-
} else {
251-
return WhyNotDefinableLast(at, scope, flags, original);
250+
auto whyNotBase{WhyNotDefinableBase(at, scope, flags, original,
251+
/*isWholeSymbol=*/true, /*isComponentPointerTarget=*/false)};
252+
if (!whyNotBase || !whyNotBase->IsFatal()) {
253+
if (auto whyNotLast{WhyNotDefinableLast(at, scope, flags, original)}) {
254+
if (whyNotLast->IsFatal() || !whyNotBase) {
255+
return whyNotLast;
256+
}
257+
}
252258
}
259+
return whyNotBase;
253260
}
254261

255262
class DuplicatedSubscriptFinder
@@ -296,6 +303,7 @@ class DuplicatedSubscriptFinder
296303
std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
297304
const Scope &scope, DefinabilityFlags flags,
298305
const evaluate::Expr<evaluate::SomeType> &expr) {
306+
std::optional<parser::Message> portabilityWarning;
299307
if (auto dataRef{evaluate::ExtractDataRef(expr, true, true)}) {
300308
if (evaluate::HasVectorSubscript(expr)) {
301309
if (flags.test(DefinabilityFlag::VectorSubscriptIsOk)) {
@@ -328,9 +336,14 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
328336
}
329337
}
330338
if (anyRankMatch && !anyElemental) {
331-
return parser::Message{at,
332-
"Variable '%s' has a vector subscript and cannot be finalized by non-elemental subroutine '%s'"_because_en_US,
333-
expr.AsFortran(), anyRankMatch->name()};
339+
if (!portabilityWarning &&
340+
scope.context().languageFeatures().ShouldWarn(
341+
common::UsageWarning::VectorSubscriptFinalization)) {
342+
portabilityWarning = parser::Message{at,
343+
"Variable '%s' has a vector subscript and will be finalized by non-elemental subroutine '%s'"_port_en_US,
344+
expr.AsFortran(), anyRankMatch->name()};
345+
}
346+
break;
334347
}
335348
const auto *parent{FindParentTypeSpec(*spec)};
336349
spec = parent ? parent->AsDerived() : nullptr;
@@ -340,32 +353,33 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
340353
if (!flags.test(DefinabilityFlag::DuplicatesAreOk) &&
341354
DuplicatedSubscriptFinder{scope.context().foldingContext()}(expr)) {
342355
return parser::Message{at,
343-
"Variable has a vector subscript with a duplicated element"_because_en_US};
356+
"Variable has a vector subscript with a duplicated element"_err_en_US};
344357
}
345358
} else {
346359
return parser::Message{at,
347-
"Variable '%s' has a vector subscript"_because_en_US,
348-
expr.AsFortran()};
360+
"Variable '%s' has a vector subscript"_err_en_US, expr.AsFortran()};
349361
}
350362
}
351363
if (FindPureProcedureContaining(scope) &&
352364
evaluate::ExtractCoarrayRef(expr)) {
353365
return parser::Message(at,
354-
"A pure subprogram may not define the coindexed object '%s'"_because_en_US,
366+
"A pure subprogram may not define the coindexed object '%s'"_err_en_US,
355367
expr.AsFortran());
356368
}
357-
return WhyNotDefinable(at, scope, flags, *dataRef);
369+
if (auto whyNotDataRef{WhyNotDefinable(at, scope, flags, *dataRef)}) {
370+
return whyNotDataRef;
371+
}
358372
} else if (evaluate::IsNullPointer(expr)) {
359373
return parser::Message{
360-
at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()};
374+
at, "'%s' is a null pointer"_err_en_US, expr.AsFortran()};
361375
} else if (flags.test(DefinabilityFlag::PointerDefinition)) {
362376
if (const auto *procDesignator{
363377
std::get_if<evaluate::ProcedureDesignator>(&expr.u)}) {
364378
// Defining a procedure pointer
365379
if (const Symbol * procSym{procDesignator->GetSymbol()}) {
366380
if (evaluate::ExtractCoarrayRef(expr)) { // C1027
367381
return BlameSymbol(at,
368-
"Procedure pointer '%s' may not be a coindexed object"_because_en_US,
382+
"Procedure pointer '%s' may not be a coindexed object"_err_en_US,
369383
*procSym, expr.AsFortran());
370384
}
371385
if (const auto *component{procDesignator->GetComponent()}) {
@@ -379,13 +393,12 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
379393
}
380394
}
381395
return parser::Message{
382-
at, "'%s' is not a definable pointer"_because_en_US, expr.AsFortran()};
396+
at, "'%s' is not a definable pointer"_err_en_US, expr.AsFortran()};
383397
} else if (!evaluate::IsVariable(expr)) {
384-
return parser::Message{at,
385-
"'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
386-
} else {
387-
return std::nullopt;
398+
return parser::Message{
399+
at, "'%s' is not a variable or pointer"_err_en_US, expr.AsFortran()};
388400
}
401+
return portabilityWarning;
389402
}
390403

391404
} // namespace Fortran::semantics

‎flang/lib/Semantics/definable.h

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,8 +36,9 @@ using DefinabilityFlags =
3636
common::EnumSet<DefinabilityFlag, DefinabilityFlag_enumSize>;
3737

3838
// Tests a symbol or LHS variable or pointer for definability in a given scope.
39-
// When the entity is not definable, returns a "because:" Message suitable for
40-
// attachment to an error message to explain why the entity cannot be defined.
39+
// When the entity is not definable, returns a Message suitable for attachment
40+
// to an error or warning message (as a "because: addendum) to explain why the
41+
// entity cannot be defined.
4142
// When the entity can be defined in that context, returns std::nullopt.
4243
std::optional<parser::Message> WhyNotDefinable(
4344
parser::CharBlock, const Scope &, DefinabilityFlags, const Symbol &);

0 commit comments

Comments
 (0)