Skip to content

Commit 70cbedc

Browse files
klauslerklausler
authored
[flang] Catch errors with INTENT(OUT) assumed rank dummy arguments (#111204)
Emit an error when an actual argument with potentially unknown size (assumed size, or non-pointer non-allocatable assumed rank) with any risk of needing initialization, finalization, or destruction is associated with an INTENT(OUT) dummy argument with assumed rank. Emit an optional portability warning for cases where the type is known to be safe from needing initialization, finalization, or destruction, since it's not conforming and might elicit an error from other compilers. Fixes #111120.
1 parent 49016d5 commit 70cbedc

File tree

3 files changed

+189
-30
lines changed

3 files changed

+189
-30
lines changed

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

Lines changed: 49 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -300,12 +300,15 @@ static void ConvertLogicalActual(evaluate::Expr<evaluate::SomeType> &actual,
300300
}
301301

302302
static bool DefersSameTypeParameters(
303-
const DerivedTypeSpec &actual, const DerivedTypeSpec &dummy) {
304-
for (const auto &pair : actual.parameters()) {
305-
const ParamValue &actualValue{pair.second};
306-
const ParamValue *dummyValue{dummy.FindParameter(pair.first)};
307-
if (!dummyValue || (actualValue.isDeferred() != dummyValue->isDeferred())) {
308-
return false;
303+
const DerivedTypeSpec *actual, const DerivedTypeSpec *dummy) {
304+
if (actual && dummy) {
305+
for (const auto &pair : actual->parameters()) {
306+
const ParamValue &actualValue{pair.second};
307+
const ParamValue *dummyValue{dummy->FindParameter(pair.first)};
308+
if (!dummyValue ||
309+
(actualValue.isDeferred() != dummyValue->isDeferred())) {
310+
return false;
311+
}
309312
}
310313
}
311314
return true;
@@ -370,9 +373,37 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
370373
}
371374
bool dummyIsAssumedRank{dummy.type.attrs().test(
372375
characteristics::TypeAndShape::Attr::AssumedRank)};
376+
bool actualIsAssumedSize{actualType.attrs().test(
377+
characteristics::TypeAndShape::Attr::AssumedSize)};
378+
bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
379+
bool actualIsPointer{evaluate::IsObjectPointer(actual)};
380+
bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
381+
bool actualMayBeAssumedSize{actualIsAssumedSize ||
382+
(actualIsAssumedRank && !actualIsPointer && !actualIsAllocatable)};
383+
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
384+
const auto *actualDerived{evaluate::GetDerivedTypeSpec(actualType.type())};
373385
if (typesCompatible) {
374386
if (isElemental) {
375387
} else if (dummyIsAssumedRank) {
388+
if (actualMayBeAssumedSize && dummy.intent == common::Intent::Out) {
389+
// An INTENT(OUT) dummy might be a no-op at run time
390+
bool dummyHasSignificantIntentOut{actualIsPolymorphic ||
391+
(actualDerived &&
392+
(actualDerived->HasDefaultInitialization(
393+
/*ignoreAllocatable=*/false, /*ignorePointer=*/true) ||
394+
actualDerived->HasDestruction()))};
395+
const char *actualDesc{
396+
actualIsAssumedSize ? "Assumed-size" : "Assumed-rank"};
397+
if (dummyHasSignificantIntentOut) {
398+
messages.Say(
399+
"%s actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization"_err_en_US,
400+
actualDesc);
401+
} else {
402+
context.Warn(common::UsageWarning::Portability, messages.at(),
403+
"%s actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument"_port_en_US,
404+
actualDesc);
405+
}
406+
}
376407
} else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
377408
} else if (dummyRank > 0 && !dummyIsAllocatableOrPointer &&
378409
!dummy.type.attrs().test(
@@ -401,11 +432,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
401432
dummy.type.type().AsFortran());
402433
}
403434

404-
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
405-
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
406435
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
407-
bool actualIsAssumedSize{actualType.attrs().test(
408-
characteristics::TypeAndShape::Attr::AssumedSize)};
409436
bool dummyIsAssumedSize{dummy.type.attrs().test(
410437
characteristics::TypeAndShape::Attr::AssumedSize)};
411438
bool dummyIsAsynchronous{
@@ -414,7 +441,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
414441
dummy.attrs.test(characteristics::DummyDataObject::Attr::Volatile)};
415442
bool dummyIsValue{
416443
dummy.attrs.test(characteristics::DummyDataObject::Attr::Value)};
417-
444+
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
418445
if (actualIsPolymorphic && dummyIsPolymorphic &&
419446
actualIsCoindexed) { // 15.5.2.4(2)
420447
messages.Say(
@@ -434,37 +461,36 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
434461
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::ASYNCHRONOUS)};
435462
bool actualIsVolatile{
436463
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::VOLATILE)};
437-
const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())};
438-
if (derived && !derived->IsVectorType()) {
464+
if (actualDerived && !actualDerived->IsVectorType()) {
439465
if (dummy.type.type().IsAssumedType()) {
440-
if (!derived->parameters().empty()) { // 15.5.2.4(2)
466+
if (!actualDerived->parameters().empty()) { // 15.5.2.4(2)
441467
messages.Say(
442468
"Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
443469
dummyName);
444470
}
445471
if (const Symbol *
446-
tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) {
472+
tbp{FindImmediateComponent(*actualDerived, [](const Symbol &symbol) {
447473
return symbol.has<ProcBindingDetails>();
448474
})}) { // 15.5.2.4(2)
449475
evaluate::SayWithDeclaration(messages, *tbp,
450476
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
451477
dummyName, tbp->name());
452478
}
453-
auto finals{FinalsForDerivedTypeInstantiation(*derived)};
479+
auto finals{FinalsForDerivedTypeInstantiation(*actualDerived)};
454480
if (!finals.empty()) { // 15.5.2.4(2)
455481
SourceName name{finals.front()->name()};
456482
if (auto *msg{messages.Say(
457483
"Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
458-
dummyName, derived->typeSymbol().name(), name)}) {
484+
dummyName, actualDerived->typeSymbol().name(), name)}) {
459485
msg->Attach(name, "FINAL subroutine '%s' in derived type '%s'"_en_US,
460-
name, derived->typeSymbol().name());
486+
name, actualDerived->typeSymbol().name());
461487
}
462488
}
463489
}
464490
if (actualIsCoindexed) {
465491
if (dummy.intent != common::Intent::In && !dummyIsValue) {
466-
if (auto bad{
467-
FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6)
492+
if (auto bad{FindAllocatableUltimateComponent(
493+
*actualDerived)}) { // 15.5.2.4(6)
468494
evaluate::SayWithDeclaration(messages, *bad,
469495
"Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
470496
bad.BuildResultDesignatorName(), dummyName);
@@ -484,7 +510,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
484510
}
485511
}
486512
if (actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
487-
if (auto bad{semantics::FindCoarrayUltimateComponent(*derived)}) {
513+
if (auto bad{semantics::FindCoarrayUltimateComponent(*actualDerived)}) {
488514
evaluate::SayWithDeclaration(messages, *bad,
489515
"VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US,
490516
dummyName, bad.BuildResultDesignatorName());
@@ -501,8 +527,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
501527
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
502528
: nullptr};
503529
int actualRank{actualType.Rank()};
504-
bool actualIsPointer{evaluate::IsObjectPointer(actual)};
505-
bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
506530
if (dummy.type.attrs().test(
507531
characteristics::TypeAndShape::Attr::AssumedShape)) {
508532
// 15.5.2.4(16)
@@ -730,7 +754,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
730754
}
731755

732756
// 15.5.2.6 -- dummy is ALLOCATABLE
733-
bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
734757
bool dummyIsOptional{
735758
dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
736759
bool actualIsNull{evaluate::IsNullPointer(actual)};
@@ -851,10 +874,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
851874
}
852875
}
853876
// 15.5.2.5(4)
854-
const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())};
855-
if ((derived &&
856-
!DefersSameTypeParameters(*derived,
857-
*evaluate::GetDerivedTypeSpec(dummy.type.type()))) ||
877+
const auto *dummyDerived{evaluate::GetDerivedTypeSpec(dummy.type.type())};
878+
if (!DefersSameTypeParameters(actualDerived, dummyDerived) ||
858879
dummy.type.type().HasDeferredTypeParameter() !=
859880
actualType.type().HasDeferredTypeParameter()) {
860881
messages.Say(

‎flang/lib/Semantics/tools.cpp

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -688,7 +688,7 @@ bool IsInitialized(const Symbol &symbol, bool ignoreDataStatements,
688688
} else if (IsNamedConstant(symbol)) {
689689
return false;
690690
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
691-
if (!object->isDummy() && object->type()) {
691+
if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
692692
if (const auto *derived{object->type()->AsDerived()}) {
693693
return derived->HasDefaultInitialization(
694694
ignoreAllocatable, ignorePointer);
@@ -705,7 +705,7 @@ bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
705705
IsPointer(symbol)) {
706706
return false;
707707
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
708-
if (!object->isDummy() && object->type()) {
708+
if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
709709
if (const auto *derived{object->type()->AsDerived()}) {
710710
return &derived->typeSymbol() != derivedTypeSymbol &&
711711
derived->HasDestruction();

0 commit comments

Comments
 (0)