[flang-commits] [flang] [flang] Catch errors with INTENT(OUT) assumed rank dummy arguments (PR #111204)
via flang-commits
flang-commits at lists.llvm.org
Fri Oct 4 13:01:14 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
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.
---
Patch is 21.01 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/111204.diff
3 Files Affected:
- (modified) flang/lib/Semantics/check-call.cpp (+49-28)
- (modified) flang/lib/Semantics/tools.cpp (+2-2)
- (added) flang/test/Semantics/call42.f90 (+138)
``````````diff
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 28a12a5798cb05..a89e10bd3e6d42 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -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(
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 3723b28fecef52..891e57c43c3733 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -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();
diff --git a/flang/test/Semantics/call42.f90 b/flang/test/Semantics/call42.f90
new file mode 100644
index 00000000000000..2d5303b58cb018
--- /dev/null
+++ b/flang/test/Semantics/call42.f90
@@ -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, de...
[truncated]
``````````
</details>
https://github.com/llvm/llvm-project/pull/111204
More information about the flang-commits
mailing list