Skip to content

[flang] Catch errors with INTENT(OUT) assumed rank dummy arguments #111204

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Oct 7, 2024
Merged

[flang] Catch errors with INTENT(OUT) assumed rank dummy arguments #111204

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
77 changes: 49 additions & 28 deletions flang/lib/Semantics/check-call.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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(
Expand Down Expand Up @@ -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{
Expand All @@ -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(
Expand All @@ -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);
Expand All @@ -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());
Expand All @@ -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)
Expand Down Expand Up @@ -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)};
Expand Down Expand Up @@ -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(
Expand Down
4 changes: 2 additions & 2 deletions flang/lib/Semantics/tools.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand All @@ -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();
Expand Down
Loading
Loading