[flang-commits] [flang] [flang] Catch more defined I/O conflicts (PR #129115)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Feb 27 12:39:17 PST 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/129115
The code that checks for conflicts between type-bound defined I/O generic procedures and non-type-bound defined I/O interfaces only works when then procedures are defined in the same module as subroutines. It doesn't catch conflicts when either are external procedures, procedure pointers, dummy procedures, &c. Extend the checking to cover those cases as well.
Fixes https://github.com/llvm/llvm-project/issues/128752.
>From 6363c2d99ec9754c675a3d9dc73f9346b8c2a626 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 27 Feb 2025 12:35:19 -0800
Subject: [PATCH] [flang] Catch more defined I/O conflicts
The code that checks for conflicts between type-bound defined I/O
generic procedures and non-type-bound defined I/O interfaces
only works when then procedures are defined in the same module
as subroutines. It doesn't catch conflicts when either are
external procedures, procedure pointers, dummy procedures, &c.
Extend the checking to cover those cases as well.
Fixes https://github.com/llvm/llvm-project/issues/128752.
---
flang/lib/Semantics/check-declarations.cpp | 57 +++++++++++++---------
flang/test/Lower/io-derived-type.f90 | 6 +--
flang/test/Semantics/io11.f90 | 24 +++++++++
3 files changed, 62 insertions(+), 25 deletions(-)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index bf4dc16a15b4a..74be495491a4f 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -161,8 +161,8 @@ class CheckHelper {
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
- void CheckDioDtvArg(
- const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
+ void CheckDioDtvArg(const Symbol &proc, const Symbol &subp, const Symbol *arg,
+ common::DefinedIo, const Symbol &generic);
void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
void CheckDioAssumedLenCharacterArg(
@@ -3338,11 +3338,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
if (const Scope * dtScope{derivedType.scope()}) {
if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end()) {
for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
- const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
- if (specific == proc) { // unambiguous, accept
- continue;
+ const Symbol *specific{&specRef->get<ProcBindingDetails>().symbol()};
+ if (specific == &proc) {
+ continue; // unambiguous, accept
}
- if (const auto *specDT{GetDtvArgDerivedType(specific)};
+ if (const auto *peDetails{specific->detailsIf<ProcEntityDetails>()}) {
+ specific = peDetails->procInterface();
+ if (!specific) {
+ continue;
+ }
+ }
+ if (const auto *specDT{GetDtvArgDerivedType(*specific)};
specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
SayWithDeclaration(*specRef, proc.name(),
"Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
@@ -3354,11 +3360,11 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
}
}
-void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
+void CheckHelper::CheckDioDummyIsDerived(const Symbol &proc, const Symbol &arg,
common::DefinedIo ioKind, const Symbol &generic) {
if (const DeclTypeSpec *type{arg.GetType()}) {
if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
- CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
+ CheckAlreadySeenDefinedIo(*derivedType, ioKind, proc, generic);
bool isPolymorphic{type->IsPolymorphic()};
if (isPolymorphic != IsExtensibleType(derivedType)) {
messages_.Say(arg.name(),
@@ -3399,11 +3405,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
}
}
-void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
- common::DefinedIo ioKind, const Symbol &generic) {
+void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
+ const Symbol *arg, common::DefinedIo ioKind, const Symbol &generic) {
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
if (CheckDioDummyIsData(subp, arg, 0)) {
- CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
+ CheckDioDummyIsDerived(proc, *arg, ioKind, generic);
CheckDioDummyAttrs(subp, *arg,
ioKind == common::DefinedIo::ReadFormatted ||
ioKind == common::DefinedIo::ReadUnformatted
@@ -3535,57 +3541,64 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
for (auto ref : details.specificProcs()) {
const Symbol &ultimate{ref->GetUltimate()};
const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
- const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
if (ultimate.attrs().test(Attr::NOPASS)) { // C774
messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
"attribute"_err_en_US,
ultimate.name());
context_.SetError(ultimate);
}
- if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
+ const Symbol *specificProc{binding ? &binding->symbol() : &ultimate};
+ const Symbol *specificSubp{specificProc};
+ if (const auto *peDetails{specificSubp->detailsIf<ProcEntityDetails>()}) {
+ specificSubp = peDetails->procInterface();
+ if (!specificSubp) {
+ continue;
+ }
+ }
+ if (const auto *subpDetails{specificSubp->detailsIf<SubprogramDetails>()}) {
const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
- CheckDioArgCount(specific, ioKind, dummyArgs.size());
+ CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
int argCount{0};
for (auto *arg : dummyArgs) {
switch (argCount++) {
case 0:
// dtv-type-spec, INTENT(INOUT) :: dtv
- CheckDioDtvArg(specific, arg, ioKind, symbol);
+ CheckDioDtvArg(*specificProc, *specificSubp, arg, ioKind, symbol);
break;
case 1:
// INTEGER, INTENT(IN) :: unit
- CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
+ CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_IN);
break;
case 2:
if (ioKind == common::DefinedIo::ReadFormatted ||
ioKind == common::DefinedIo::WriteFormatted) {
// CHARACTER (LEN=*), INTENT(IN) :: iotype
CheckDioAssumedLenCharacterArg(
- specific, arg, argCount, Attr::INTENT_IN);
+ *specificSubp, arg, argCount, Attr::INTENT_IN);
} else {
// INTEGER, INTENT(OUT) :: iostat
- CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+ CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
}
break;
case 3:
if (ioKind == common::DefinedIo::ReadFormatted ||
ioKind == common::DefinedIo::WriteFormatted) {
// INTEGER, INTENT(IN) :: v_list(:)
- CheckDioVlistArg(specific, arg, argCount);
+ CheckDioVlistArg(*specificSubp, arg, argCount);
} else {
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
CheckDioAssumedLenCharacterArg(
- specific, arg, argCount, Attr::INTENT_INOUT);
+ *specificSubp, arg, argCount, Attr::INTENT_INOUT);
}
break;
case 4:
// INTEGER, INTENT(OUT) :: iostat
- CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+ CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
break;
case 5:
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
CheckDioAssumedLenCharacterArg(
- specific, arg, argCount, Attr::INTENT_INOUT);
+ *specificSubp, arg, argCount, Attr::INTENT_INOUT);
break;
default:;
}
diff --git a/flang/test/Lower/io-derived-type.f90 b/flang/test/Lower/io-derived-type.f90
index 8ac995739afd7..f96feca77c485 100644
--- a/flang/test/Lower/io-derived-type.f90
+++ b/flang/test/Lower/io-derived-type.f90
@@ -22,7 +22,7 @@ subroutine wft(dtv, unit, iotype, v_list, iostat, iomsg)
! CHECK-LABEL: @_QMmPwftd
subroutine wftd(dtv, unit, iotype, v_list, iostat, iomsg)
- type(t), intent(in) :: dtv
+ class(t), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
@@ -91,13 +91,13 @@ subroutine test3(p, x)
! CHECK: %[[V_10:[0-9]+]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> !fir.ref<none>
! CHECK: %[[V_11:[0-9]+]] = fir.insert_value %[[V_9]], %[[V_10]], [0 : index, 1 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, !fir.ref<none>) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
! CHECK: %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c2{{.*}}, [0 : index, 2 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i32) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
- ! CHECK: %[[V_13:[0-9]+]] = fir.insert_value %[[V_12]], %false, [0 : index, 3 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i1) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
+ ! CHECK: %[[V_13:[0-9]+]] = fir.insert_value %[[V_12]], %true, [0 : index, 3 : index] : (!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>, i1) -> !fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>
! CHECK: fir.store %[[V_13]] to %[[V_5]] : !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>
! CHECK: %[[V_14:[0-9]+]] = fir.alloca tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
! CHECK: %[[V_15:[0-9]+]] = fir.undefined tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
! CHECK: %[[V_16:[0-9]+]] = fir.insert_value %[[V_15]], %c1{{.*}}, [0 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i64) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
! CHECK: %[[V_17:[0-9]+]] = fir.insert_value %[[V_16]], %[[V_5]], [1 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
- ! CHECK: %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %true, [2 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i1) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
+ ! CHECK: %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %true_0, [2 : index] : (tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>, i1) -> tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
! CHECK: fir.store %[[V_18]] to %[[V_14]] : !fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>
! CHECK: %[[V_19:[0-9]+]] = fir.convert %[[V_14]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>) -> !fir.ref<none>
! CHECK: %[[V_20:[0-9]+]] = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %[[V_4]], %[[V_19]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 9b5ad1b8427d9..37c6cf1e6befa 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -689,3 +689,27 @@ module m26b
procedure unformattedRead
end interface
end
+
+module m27
+ type t
+ contains
+ procedure, private :: write1
+ generic :: write(formatted) => write1
+ end type
+ abstract interface
+ subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
+ import t
+ class(t), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: v_list(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ end
+ end interface
+ !ERROR: Derived type 't' has conflicting type-bound input/output procedure 'write(formatted)'
+ procedure(absWrite) write1, write2
+ interface write(formatted)
+ procedure write2
+ end interface
+end
More information about the flang-commits
mailing list