[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 https://github.com/llvm/llvm-project/issues/111120.
This commit is contained in:
Peter Klausler 2024-10-07 13:17:45 -07:00 committed by GitHub
parent 49016d53e8
commit 70cbedcd6e
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 189 additions and 30 deletions

View File

@ -300,12 +300,15 @@ static void ConvertLogicalActual(evaluate::Expr<evaluate::SomeType> &actual,
}
static bool DefersSameTypeParameters(
const DerivedTypeSpec &actual, const DerivedTypeSpec &dummy) {
for (const auto &pair : actual.parameters()) {
const ParamValue &actualValue{pair.second};
const ParamValue *dummyValue{dummy.FindParameter(pair.first)};
if (!dummyValue || (actualValue.isDeferred() != dummyValue->isDeferred())) {
return false;
const DerivedTypeSpec *actual, const DerivedTypeSpec *dummy) {
if (actual && dummy) {
for (const auto &pair : actual->parameters()) {
const ParamValue &actualValue{pair.second};
const ParamValue *dummyValue{dummy->FindParameter(pair.first)};
if (!dummyValue ||
(actualValue.isDeferred() != dummyValue->isDeferred())) {
return false;
}
}
}
return true;
@ -370,9 +373,37 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
bool dummyIsAssumedRank{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)};
bool actualIsAssumedSize{actualType.attrs().test(
characteristics::TypeAndShape::Attr::AssumedSize)};
bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
bool actualIsPointer{evaluate::IsObjectPointer(actual)};
bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
bool actualMayBeAssumedSize{actualIsAssumedSize ||
(actualIsAssumedRank && !actualIsPointer && !actualIsAllocatable)};
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
const auto *actualDerived{evaluate::GetDerivedTypeSpec(actualType.type())};
if (typesCompatible) {
if (isElemental) {
} else if (dummyIsAssumedRank) {
if (actualMayBeAssumedSize && dummy.intent == common::Intent::Out) {
// An INTENT(OUT) dummy might be a no-op at run time
bool dummyHasSignificantIntentOut{actualIsPolymorphic ||
(actualDerived &&
(actualDerived->HasDefaultInitialization(
/*ignoreAllocatable=*/false, /*ignorePointer=*/true) ||
actualDerived->HasDestruction()))};
const char *actualDesc{
actualIsAssumedSize ? "Assumed-size" : "Assumed-rank"};
if (dummyHasSignificantIntentOut) {
messages.Say(
"%s actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization"_err_en_US,
actualDesc);
} else {
context.Warn(common::UsageWarning::Portability, messages.at(),
"%s actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument"_port_en_US,
actualDesc);
}
}
} else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
} else if (dummyRank > 0 && !dummyIsAllocatableOrPointer &&
!dummy.type.attrs().test(
@ -401,11 +432,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.type.type().AsFortran());
}
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
bool actualIsAssumedSize{actualType.attrs().test(
characteristics::TypeAndShape::Attr::AssumedSize)};
bool dummyIsAssumedSize{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedSize)};
bool dummyIsAsynchronous{
@ -414,7 +441,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.attrs.test(characteristics::DummyDataObject::Attr::Volatile)};
bool dummyIsValue{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Value)};
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
if (actualIsPolymorphic && dummyIsPolymorphic &&
actualIsCoindexed) { // 15.5.2.4(2)
messages.Say(
@ -434,37 +461,36 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::ASYNCHRONOUS)};
bool actualIsVolatile{
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::VOLATILE)};
const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())};
if (derived && !derived->IsVectorType()) {
if (actualDerived && !actualDerived->IsVectorType()) {
if (dummy.type.type().IsAssumedType()) {
if (!derived->parameters().empty()) { // 15.5.2.4(2)
if (!actualDerived->parameters().empty()) { // 15.5.2.4(2)
messages.Say(
"Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
dummyName);
}
if (const Symbol *
tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) {
tbp{FindImmediateComponent(*actualDerived, [](const Symbol &symbol) {
return symbol.has<ProcBindingDetails>();
})}) { // 15.5.2.4(2)
evaluate::SayWithDeclaration(messages, *tbp,
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
dummyName, tbp->name());
}
auto finals{FinalsForDerivedTypeInstantiation(*derived)};
auto finals{FinalsForDerivedTypeInstantiation(*actualDerived)};
if (!finals.empty()) { // 15.5.2.4(2)
SourceName name{finals.front()->name()};
if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
dummyName, derived->typeSymbol().name(), name)}) {
dummyName, actualDerived->typeSymbol().name(), name)}) {
msg->Attach(name, "FINAL subroutine '%s' in derived type '%s'"_en_US,
name, derived->typeSymbol().name());
name, actualDerived->typeSymbol().name());
}
}
}
if (actualIsCoindexed) {
if (dummy.intent != common::Intent::In && !dummyIsValue) {
if (auto bad{
FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6)
if (auto bad{FindAllocatableUltimateComponent(
*actualDerived)}) { // 15.5.2.4(6)
evaluate::SayWithDeclaration(messages, *bad,
"Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
bad.BuildResultDesignatorName(), dummyName);
@ -484,7 +510,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
if (actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
if (auto bad{semantics::FindCoarrayUltimateComponent(*derived)}) {
if (auto bad{semantics::FindCoarrayUltimateComponent(*actualDerived)}) {
evaluate::SayWithDeclaration(messages, *bad,
"VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US,
dummyName, bad.BuildResultDesignatorName());
@ -501,8 +527,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
: nullptr};
int actualRank{actualType.Rank()};
bool actualIsPointer{evaluate::IsObjectPointer(actual)};
bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
if (dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)) {
// 15.5.2.4(16)
@ -730,7 +754,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
// 15.5.2.6 -- dummy is ALLOCATABLE
bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
bool dummyIsOptional{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
bool actualIsNull{evaluate::IsNullPointer(actual)};
@ -851,10 +874,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
// 15.5.2.5(4)
const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())};
if ((derived &&
!DefersSameTypeParameters(*derived,
*evaluate::GetDerivedTypeSpec(dummy.type.type()))) ||
const auto *dummyDerived{evaluate::GetDerivedTypeSpec(dummy.type.type())};
if (!DefersSameTypeParameters(actualDerived, dummyDerived) ||
dummy.type.type().HasDeferredTypeParameter() !=
actualType.type().HasDeferredTypeParameter()) {
messages.Say(

View File

@ -688,7 +688,7 @@ bool IsInitialized(const Symbol &symbol, bool ignoreDataStatements,
} else if (IsNamedConstant(symbol)) {
return false;
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
if (!object->isDummy() && object->type()) {
if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
if (const auto *derived{object->type()->AsDerived()}) {
return derived->HasDefaultInitialization(
ignoreAllocatable, ignorePointer);
@ -705,7 +705,7 @@ bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
IsPointer(symbol)) {
return false;
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
if (!object->isDummy() && object->type()) {
if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
if (const auto *derived{object->type()->AsDerived()}) {
return &derived->typeSymbol() != derivedTypeSymbol &&
derived->HasDestruction();

View File

@ -0,0 +1,138 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
module m
type boring
end type
type hasAlloc
real, allocatable :: x
end type
type hasInit
real :: x = 1.
end type
type hasFinal
contains
final final
end type
contains
elemental subroutine final(x)
type(hasFinal), intent(in out) :: x
end
recursive subroutine typeOutAssumedRank(a,b,c,d)
type(boring), intent(out) :: a(..)
type(hasAlloc), intent(out) :: b(..)
type(hasInit), intent(out) :: c(..)
type(hasFinal), intent(out) :: d(..)
!PORTABILITY: Assumed-rank actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call typeOutAssumedRank(a, b, c, d)
!PORTABILITY: Assumed-rank actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call classOutAssumedRank(a, b, c, d)
!PORTABILITY: Assumed-rank actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a, b, c, d)
end
recursive subroutine typeOutAssumedRankAlloc(a,b,c,d)
type(boring), intent(out), allocatable :: a(..)
type(hasAlloc), intent(out), allocatable :: b(..)
type(hasInit), intent(out), allocatable :: c(..)
type(hasFinal), intent(out), allocatable :: d(..)
call typeOutAssumedRank(a, b, c, d)
call typeOutAssumedRankAlloc(a, b, c, d)
end
recursive subroutine classOutAssumedRank(a,b,c,d)
class(boring), intent(out) :: a(..)
class(hasAlloc), intent(out) :: b(..)
class(hasInit), intent(out) :: c(..)
class(hasFinal), intent(out) :: d(..)
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call typeOutAssumedRank(a, b, c, d)
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call classOutAssumedRank(a, b, c, d)
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a, b, c, d)
end
recursive subroutine classOutAssumedRankAlloc(a,b,c,d)
class(boring), intent(out), allocatable :: a(..)
class(hasAlloc), intent(out), allocatable :: b(..)
class(hasInit), intent(out), allocatable :: c(..)
class(hasFinal), intent(out), allocatable :: d(..)
call classOutAssumedRank(a, b, c, d)
call classOutAssumedRankAlloc(a, b, c, d)
call unlimitedOutAssumedRank(a, b, c, d)
end
recursive subroutine unlimitedOutAssumedRank(a,b,c,d)
class(*), intent(out) :: a(..), b(..), c(..), d(..)
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-rank actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a, b, c, d)
end
recursive subroutine unlimitedOutAssumedRankAlloc(a,b,c,d)
class(*), intent(out), allocatable :: a(..), b(..), c(..), d(..)
call unlimitedOutAssumedRank(a, b, c, d)
call unlimitedOutAssumedRankAlloc(a, b, c, d)
end
subroutine typeAssumedSize(a,b,c,d)
type(boring) a(*)
type(hasAlloc) b(*)
type(hasInit) c(*)
type(hasFinal) d(*)
!PORTABILITY: Assumed-size actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call typeOutAssumedRank(a,b,c,d)
!PORTABILITY: Assumed-size actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call classOutAssumedRank(a,b,c,d)
!PORTABILITY: Assumed-size actual argument should not be associated with INTENT(OUT) assumed-rank dummy argument
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a,b,c,d)
end
subroutine classAssumedSize(a,b,c,d)
class(boring) a(*)
class(hasAlloc) b(*)
class(hasInit) c(*)
class(hasFinal) d(*)
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call classOutAssumedRank(a,b,c,d)
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a,b,c,d)
end
subroutine unlimitedAssumedSize(a,b,c,d)
class(*) a(*), b(*), c(*), d(*)
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
!ERROR: Assumed-size actual argument may not be associated with INTENT(OUT) assumed-rank dummy argument requiring finalization, destruction, or initialization
call unlimitedOutAssumedRank(a, b, c, d)
end
end