Skip to content

Commit cef50ad

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 cbef629 commit cef50ad

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(
@@ -3429,11 +3429,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
34293429
if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end() &&
34303430
IsAccessible(*iter->second, generic.owner())) {
34313431
for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
3432-
const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
3433-
if (specific == proc) {
3432+
const Symbol *specific{&specRef->get<ProcBindingDetails>().symbol()};
3433+
if (specific == &proc) {
34343434
continue; // unambiguous, accept
34353435
}
3436-
if (const auto *specDT{GetDtvArgDerivedType(specific)};
3436+
if (const auto *peDetails{specific->detailsIf<ProcEntityDetails>()}) {
3437+
specific = peDetails->procInterface();
3438+
if (!specific) {
3439+
continue;
3440+
}
3441+
}
3442+
if (const auto *specDT{GetDtvArgDerivedType(*specific)};
34373443
specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
34383444
SayWithDeclaration(*specRef, proc.name(),
34393445
"Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
@@ -3445,11 +3451,11 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
34453451
}
34463452
}
34473453

3448-
void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
3454+
void CheckHelper::CheckDioDummyIsDerived(const Symbol &proc, const Symbol &arg,
34493455
common::DefinedIo ioKind, const Symbol &generic) {
34503456
if (const DeclTypeSpec *type{arg.GetType()}) {
34513457
if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
3452-
CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
3458+
CheckAlreadySeenDefinedIo(*derivedType, ioKind, proc, generic);
34533459
bool isPolymorphic{type->IsPolymorphic()};
34543460
if (isPolymorphic != IsExtensibleType(derivedType)) {
34553461
messages_.Say(arg.name(),
@@ -3487,11 +3493,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
34873493
}
34883494
}
34893495

3490-
void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
3491-
common::DefinedIo ioKind, const Symbol &generic) {
3496+
void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp,
3497+
const Symbol *arg, common::DefinedIo ioKind, const Symbol &generic) {
34923498
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
34933499
if (CheckDioDummyIsData(subp, arg, 0)) {
3494-
CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
3500+
CheckDioDummyIsDerived(proc, *arg, ioKind, generic);
34953501
CheckDioDummyAttrs(subp, *arg,
34963502
ioKind == common::DefinedIo::ReadFormatted ||
34973503
ioKind == common::DefinedIo::ReadUnformatted
@@ -3618,57 +3624,64 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
36183624
for (auto ref : details.specificProcs()) {
36193625
const Symbol &ultimate{ref->GetUltimate()};
36203626
const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
3621-
const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
36223627
if (ultimate.attrs().test(Attr::NOPASS)) { // C774
36233628
messages_.Say(
36243629
"Defined input/output procedure '%s' may not have NOPASS attribute"_err_en_US,
36253630
ultimate.name());
36263631
context_.SetError(ultimate);
36273632
}
3628-
if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
3633+
const Symbol *specificProc{binding ? &binding->symbol() : &ultimate};
3634+
const Symbol *specificSubp{specificProc};
3635+
if (const auto *peDetails{specificSubp->detailsIf<ProcEntityDetails>()}) {
3636+
specificSubp = peDetails->procInterface();
3637+
if (!specificSubp) {
3638+
continue;
3639+
}
3640+
}
3641+
if (const auto *subpDetails{specificSubp->detailsIf<SubprogramDetails>()}) {
36293642
const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
3630-
CheckDioArgCount(specific, ioKind, dummyArgs.size());
3643+
CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
36313644
int argCount{0};
36323645
for (auto *arg : dummyArgs) {
36333646
switch (argCount++) {
36343647
case 0:
36353648
// dtv-type-spec, INTENT(INOUT) :: dtv
3636-
CheckDioDtvArg(specific, arg, ioKind, symbol);
3649+
CheckDioDtvArg(*specificProc, *specificSubp, arg, ioKind, symbol);
36373650
break;
36383651
case 1:
36393652
// INTEGER, INTENT(IN) :: unit
3640-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
3653+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_IN);
36413654
break;
36423655
case 2:
36433656
if (ioKind == common::DefinedIo::ReadFormatted ||
36443657
ioKind == common::DefinedIo::WriteFormatted) {
36453658
// CHARACTER (LEN=*), INTENT(IN) :: iotype
36463659
CheckDioAssumedLenCharacterArg(
3647-
specific, arg, argCount, Attr::INTENT_IN);
3660+
*specificSubp, arg, argCount, Attr::INTENT_IN);
36483661
} else {
36493662
// INTEGER, INTENT(OUT) :: iostat
3650-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3663+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
36513664
}
36523665
break;
36533666
case 3:
36543667
if (ioKind == common::DefinedIo::ReadFormatted ||
36553668
ioKind == common::DefinedIo::WriteFormatted) {
36563669
// INTEGER, INTENT(IN) :: v_list(:)
3657-
CheckDioVlistArg(specific, arg, argCount);
3670+
CheckDioVlistArg(*specificSubp, arg, argCount);
36583671
} else {
36593672
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
36603673
CheckDioAssumedLenCharacterArg(
3661-
specific, arg, argCount, Attr::INTENT_INOUT);
3674+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
36623675
}
36633676
break;
36643677
case 4:
36653678
// INTEGER, INTENT(OUT) :: iostat
3666-
CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
3679+
CheckDefaultIntegerArg(*specificSubp, arg, Attr::INTENT_OUT);
36673680
break;
36683681
case 5:
36693682
// CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
36703683
CheckDioAssumedLenCharacterArg(
3671-
specific, arg, argCount, Attr::INTENT_INOUT);
3684+
*specificSubp, arg, argCount, Attr::INTENT_INOUT);
36723685
break;
36733686
default:;
36743687
}

‎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)