Skip to content

Commit 51dc526

Browse files
klauslerklausler
authored
[flang] Catch more defined I/O conflicts (#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 #128752.
1 parent abe1ecf commit 51dc526

File tree

3 files changed

+61
-24
lines changed

3 files changed

+61
-24
lines changed

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

Lines changed: 34 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -165,8 +165,8 @@ class CheckHelper {
165165
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
166166
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
167167
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
168-
void CheckDioDtvArg(
169-
const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
168+
void CheckDioDtvArg(const Symbol &proc, const Symbol &subp, const Symbol *arg,
169+
common::DefinedIo, const Symbol &generic);
170170
void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
171171
void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
172172
void CheckDioAssumedLenCharacterArg(
@@ -3428,11 +3428,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
34283428
if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end() &&
34293429
IsAccessible(*iter->second, generic.owner())) {
34303430
for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
3431-
const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
3432-
if (specific == proc) {
3431+
const Symbol *specific{&specRef->get<ProcBindingDetails>().symbol()};
3432+
if (specific == &proc) {
34333433
continue; // unambiguous, accept
34343434
}
3435-
if (const auto *specDT{GetDtvArgDerivedType(specific)};
3435+
if (const auto *peDetails{specific->detailsIf<ProcEntityDetails>()}) {
3436+
specific = peDetails->procInterface();
3437+
if (!specific) {
3438+
continue;
3439+
}
3440+
}
3441+
if (const auto *specDT{GetDtvArgDerivedType(*specific)};
34363442
specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
34373443
SayWithDeclaration(*specRef, proc.name(),
34383444
"Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
@@ -3444,11 +3450,11 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
34443450
}
34453451
}
34463452

3447-
void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
3453+
void CheckHelper::CheckDioDummyIsDerived(const Symbol &proc, const Symbol &arg,
34483454
common::DefinedIo ioKind, const Symbol &generic) {
34493455
if (const DeclTypeSpec *type{arg.GetType()}) {
34503456
if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
3451-
CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
3457+
CheckAlreadySeenDefinedIo(*derivedType, ioKind, proc, generic);
34523458
bool isPolymorphic{type->IsPolymorphic()};
34533459
if (isPolymorphic != IsExtensibleType(derivedType)) {
34543460
messages_.Say(arg.name(),
@@ -3486,11 +3492,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
34863492
}
34873493
}
34883494

3489-
void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
3490-
common::DefinedIo ioKind, const Symbol &generic) {
3495+
void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
3496+
const Symbol *arg, common::DefinedIo ioKind, const Symbol &generic) {
34913497
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
34923498
if (CheckDioDummyIsData(subp, arg, 0)) {
3493-
CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
3499+
CheckDioDummyIsDerived(proc, *arg, ioKind, generic);
34943500
CheckDioDummyAttrs(subp, *arg,
34953501
ioKind == common::DefinedIo::ReadFormatted ||
34963502
ioKind == common::DefinedIo::ReadUnformatted
@@ -3617,57 +3623,64 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
36173623
for (auto ref : details.specificProcs()) {
36183624
const Symbol &ultimate{ref->GetUltimate()};
36193625
const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
3620-
const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
36213626
if (ultimate.attrs().test(Attr::NOPASS)) { // C774
36223627
messages_.Say(
36233628
"Defined input/output procedure '%s' may not have NOPASS attribute"_err_en_US,
36243629
ultimate.name());
36253630
context_.SetError(ultimate);
36263631
}
3627-
if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
3632+
const Symbol *specificProc{binding ? &binding->symbol() : &ultimate};
3633+
const Symbol *specificSubp{specificProc};
3634+
if (const auto *peDetails{specificSubp->detailsIf<ProcEntityDetails>()}) {
3635+
specificSubp = peDetails->procInterface();
3636+
if (!specificSubp) {
3637+
continue;
3638+
}
3639+
}
3640+
if (const auto *subpDetails{specificSubp->detailsIf<SubprogramDetails>()}) {
36283641
const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
3629-
CheckDioArgCount(specific, ioKind, dummyArgs.size());
3642+
CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
36303643
int argCount{0};
36313644
for (auto *arg : dummyArgs) {
36323645
switch (argCount++) {
36333646
case 0:
36343647
// dtv-type-spec, INTENT(INOUT) :: dtv
3635-
CheckDioDtvArg(specific, arg, ioKind, symbol);
3648+
CheckDioDtvArg(*specificProc, *specificSubp, arg, ioKind, symbol);
36363649
break;
36373650
case 1:
36383651
// INTEGER, INTENT(IN) :: unit
3639-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
3652+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_IN);
36403653
break;
36413654
case 2:
36423655
if (ioKind == common::DefinedIo::ReadFormatted ||
36433656
ioKind == common::DefinedIo::WriteFormatted) {
36443657
// CHARACTER (LEN=*), INTENT(IN) :: iotype
36453658
CheckDioAssumedLenCharacterArg(
3646-
specific, arg, argCount, Attr::INTENT_IN);
3659+
*specificSubp, arg, argCount, Attr::INTENT_IN);
36473660
} else {
36483661
// INTEGER, INTENT(OUT) :: iostat
3649-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3662+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
36503663
}
36513664
break;
36523665
case 3:
36533666
if (ioKind == common::DefinedIo::ReadFormatted ||
36543667
ioKind == common::DefinedIo::WriteFormatted) {
36553668
// INTEGER, INTENT(IN) :: v_list(:)
3656-
CheckDioVlistArg(specific, arg, argCount);
3669+
CheckDioVlistArg(*specificSubp, arg, argCount);
36573670
} else {
36583671
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
36593672
CheckDioAssumedLenCharacterArg(
3660-
specific, arg, argCount, Attr::INTENT_INOUT);
3673+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
36613674
}
36623675
break;
36633676
case 4:
36643677
// INTEGER, INTENT(OUT) :: iostat
3665-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3678+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
36663679
break;
36673680
case 5:
36683681
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
36693682
CheckDioAssumedLenCharacterArg(
3670-
specific, arg, argCount, Attr::INTENT_INOUT);
3683+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
36713684
break;
36723685
default:;
36733686
}

‎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
@@ -720,3 +720,27 @@ subroutine ur2(dtv,unit,iostat,iomsg)
720720
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
721721
end
722722
end
723+
724+
module m28
725+
type t
726+
contains
727+
procedure, private :: write1
728+
generic :: write(formatted) => write1
729+
end type
730+
abstract interface
731+
subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
732+
import t
733+
class(t), intent(in) :: dtv
734+
integer, intent(in) :: unit
735+
character(*), intent(in) :: iotype
736+
integer, intent(in) :: v_list(:)
737+
integer, intent(out) :: iostat
738+
character(*), intent(inout) :: iomsg
739+
end
740+
end interface
741+
!ERROR: Derived type 't' has conflicting type-bound input/output procedure 'write(formatted)'
742+
procedure(absWrite) write1, write2
743+
interface write(formatted)
744+
procedure write2
745+
end interface
746+
end

0 commit comments

Comments
 (0)