Skip to content

Commit 6363c2d

Browse files
klauslerklausler
committed
[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 #128752.
1 parent 9884803 commit 6363c2d

File tree

3 files changed

+62
-25
lines changed

3 files changed

+62
-25
lines changed

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

Lines changed: 35 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -161,8 +161,8 @@ class CheckHelper {
161161
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
162162
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
163163
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
164-
void CheckDioDtvArg(
165-
const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
164+
void CheckDioDtvArg(const Symbol &proc, const Symbol &subp, const Symbol *arg,
165+
common::DefinedIo, const Symbol &generic);
166166
void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
167167
void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
168168
void CheckDioAssumedLenCharacterArg(
@@ -3338,11 +3338,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
33383338
if (const Scope * dtScope{derivedType.scope()}) {
33393339
if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end()) {
33403340
for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
3341-
const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
3342-
if (specific == proc) { // unambiguous, accept
3343-
continue;
3341+
const Symbol *specific{&specRef->get<ProcBindingDetails>().symbol()};
3342+
if (specific == &proc) {
3343+
continue; // unambiguous, accept
33443344
}
3345-
if (const auto *specDT{GetDtvArgDerivedType(specific)};
3345+
if (const auto *peDetails{specific->detailsIf<ProcEntityDetails>()}) {
3346+
specific = peDetails->procInterface();
3347+
if (!specific) {
3348+
continue;
3349+
}
3350+
}
3351+
if (const auto *specDT{GetDtvArgDerivedType(*specific)};
33463352
specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
33473353
SayWithDeclaration(*specRef, proc.name(),
33483354
"Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
@@ -3354,11 +3360,11 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
33543360
}
33553361
}
33563362

3357-
void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
3363+
void CheckHelper::CheckDioDummyIsDerived(const Symbol &proc, const Symbol &arg,
33583364
common::DefinedIo ioKind, const Symbol &generic) {
33593365
if (const DeclTypeSpec *type{arg.GetType()}) {
33603366
if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
3361-
CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
3367+
CheckAlreadySeenDefinedIo(*derivedType, ioKind, proc, generic);
33623368
bool isPolymorphic{type->IsPolymorphic()};
33633369
if (isPolymorphic != IsExtensibleType(derivedType)) {
33643370
messages_.Say(arg.name(),
@@ -3399,11 +3405,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
33993405
}
34003406
}
34013407

3402-
void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
3403-
common::DefinedIo ioKind, const Symbol &generic) {
3408+
void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
3409+
const Symbol *arg, common::DefinedIo ioKind, const Symbol &generic) {
34043410
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
34053411
if (CheckDioDummyIsData(subp, arg, 0)) {
3406-
CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
3412+
CheckDioDummyIsDerived(proc, *arg, ioKind, generic);
34073413
CheckDioDummyAttrs(subp, *arg,
34083414
ioKind == common::DefinedIo::ReadFormatted ||
34093415
ioKind == common::DefinedIo::ReadUnformatted
@@ -3535,57 +3541,64 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
35353541
for (auto ref : details.specificProcs()) {
35363542
const Symbol &ultimate{ref->GetUltimate()};
35373543
const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
3538-
const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
35393544
if (ultimate.attrs().test(Attr::NOPASS)) { // C774
35403545
messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
35413546
"attribute"_err_en_US,
35423547
ultimate.name());
35433548
context_.SetError(ultimate);
35443549
}
3545-
if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
3550+
const Symbol *specificProc{binding ? &binding->symbol() : &ultimate};
3551+
const Symbol *specificSubp{specificProc};
3552+
if (const auto *peDetails{specificSubp->detailsIf<ProcEntityDetails>()}) {
3553+
specificSubp = peDetails->procInterface();
3554+
if (!specificSubp) {
3555+
continue;
3556+
}
3557+
}
3558+
if (const auto *subpDetails{specificSubp->detailsIf<SubprogramDetails>()}) {
35463559
const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
3547-
CheckDioArgCount(specific, ioKind, dummyArgs.size());
3560+
CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
35483561
int argCount{0};
35493562
for (auto *arg : dummyArgs) {
35503563
switch (argCount++) {
35513564
case 0:
35523565
// dtv-type-spec, INTENT(INOUT) :: dtv
3553-
CheckDioDtvArg(specific, arg, ioKind, symbol);
3566+
CheckDioDtvArg(*specificProc, *specificSubp, arg, ioKind, symbol);
35543567
break;
35553568
case 1:
35563569
// INTEGER, INTENT(IN) :: unit
3557-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
3570+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_IN);
35583571
break;
35593572
case 2:
35603573
if (ioKind == common::DefinedIo::ReadFormatted ||
35613574
ioKind == common::DefinedIo::WriteFormatted) {
35623575
// CHARACTER (LEN=*), INTENT(IN) :: iotype
35633576
CheckDioAssumedLenCharacterArg(
3564-
specific, arg, argCount, Attr::INTENT_IN);
3577+
*specificSubp, arg, argCount, Attr::INTENT_IN);
35653578
} else {
35663579
// INTEGER, INTENT(OUT) :: iostat
3567-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3580+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
35683581
}
35693582
break;
35703583
case 3:
35713584
if (ioKind == common::DefinedIo::ReadFormatted ||
35723585
ioKind == common::DefinedIo::WriteFormatted) {
35733586
// INTEGER, INTENT(IN) :: v_list(:)
3574-
CheckDioVlistArg(specific, arg, argCount);
3587+
CheckDioVlistArg(*specificSubp, arg, argCount);
35753588
} else {
35763589
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
35773590
CheckDioAssumedLenCharacterArg(
3578-
specific, arg, argCount, Attr::INTENT_INOUT);
3591+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
35793592
}
35803593
break;
35813594
case 4:
35823595
// INTEGER, INTENT(OUT) :: iostat
3583-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3596+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
35843597
break;
35853598
case 5:
35863599
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
35873600
CheckDioAssumedLenCharacterArg(
3588-
specific, arg, argCount, Attr::INTENT_INOUT);
3601+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
35893602
break;
35903603
default:;
35913604
}

‎flang/test/Lower/io-derived-type.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ subroutine wft(dtv, unit, iotype, v_list, iostat, iomsg)
2222

2323
! CHECK-LABEL: @_QMmPwftd
2424
subroutine wftd(dtv, unit, iotype, v_list, iostat, iomsg)
25-
type(t), intent(in) :: dtv
25+
class(t), intent(in) :: dtv
2626
integer, intent(in) :: unit
2727
character(*), intent(in) :: iotype
2828
integer, intent(in) :: v_list(:)
@@ -91,13 +91,13 @@ subroutine test3(p, x)
9191
! CHECK: %[[V_10:[0-9]+]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> !fir.ref<none>
9292
! 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>>
9393
! 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>>
94-
! 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>>
94+
! 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>>
9595
! CHECK: fir.store %[[V_13]] to %[[V_5]] : !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>
9696
! CHECK: %[[V_14:[0-9]+]] = fir.alloca tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
9797
! CHECK: %[[V_15:[0-9]+]] = fir.undefined tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>
9898
! 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>
9999
! 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>
100-
! 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>
100+
! 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>
101101
! 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>>
102102
! 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>
103103
! CHECK: %[[V_20:[0-9]+]] = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %[[V_4]], %[[V_19]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1

‎flang/test/Semantics/io11.f90

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -689,3 +689,27 @@ module m26b
689689
procedure unformattedRead
690690
end interface
691691
end
692+
693+
module m27
694+
type t
695+
contains
696+
procedure, private :: write1
697+
generic :: write(formatted) => write1
698+
end type
699+
abstract interface
700+
subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
701+
import t
702+
class(t), intent(in) :: dtv
703+
integer, intent(in) :: unit
704+
character(*), intent(in) :: iotype
705+
integer, intent(in) :: v_list(:)
706+
integer, intent(out) :: iostat
707+
character(*), intent(inout) :: iomsg
708+
end
709+
end interface
710+
!ERROR: Derived type 't' has conflicting type-bound input/output procedure 'write(formatted)'
711+
procedure(absWrite) write1, write2
712+
interface write(formatted)
713+
procedure write2
714+
end interface
715+
end

0 commit comments

Comments
 (0)