Skip to content

[flang] Catch more defined I/O conflicts #129115

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Feb 28, 2025
Merged

[flang] Catch more defined I/O conflicts #129115

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 34 additions & 21 deletions flang/lib/Semantics/check-declarations.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,8 +165,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(
Expand Down Expand Up @@ -3429,11 +3429,17 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end() &&
IsAccessible(*iter->second, generic.owner())) {
for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
if (specific == proc) {
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,
Expand All @@ -3445,11 +3451,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(),
Expand Down Expand Up @@ -3487,11 +3493,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
Expand Down Expand Up @@ -3618,57 +3624,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:;
}
Expand Down
6 changes: 3 additions & 3 deletions flang/test/Lower/io-derived-type.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(:)
Expand Down Expand Up @@ -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
Expand Down
24 changes: 24 additions & 0 deletions flang/test/Semantics/io11.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -720,3 +720,27 @@ subroutine ur2(dtv,unit,iostat,iomsg)
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
end
end

module m28
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