caio/clang-p2996
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[flang][runtime] Allow INQUIRE(IOLENGTH=) in the presence of defined I/O (#144541)

Browse Source 
When I/O list items include instances of derived types for which defined
I/O procedures exist, ignore them.

Fixes https://github.com/llvm/llvm-project/issues/144363.
This commit is contained in:
Peter Klausler
2025-06-30 10:20:39 -07:00
committed by GitHub
parent 83b462af17
commit dccc0266f4
2 changed files with 40 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
flang-rt/lib/runtime/descriptor-io.cpp
View File

@@ -451,39 +451,42 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
if (const typeInfo::DerivedType *type{
addendum ? addendum->derivedType() : nullptr}) {
// derived type unformatted I/O
if (table_) {
if (const auto *definedIo{table_->Find(*type,
DIR == Direction::Input
? common::DefinedIo::ReadUnformatted
: common::DefinedIo::WriteUnformatted)}) {
if (definedIo->subroutine) {
typeInfo::SpecialBinding special{DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted,
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
false};
if (DefinedUnformattedIo(io_, instance_, *type, special)) {
anyIoTookPlace_ = true;
return StatOk;
if (DIR == Direction::Input || !io_.get_if<InquireIOLengthState>()) {
if (table_) {
if (const auto *definedIo{table_->Find(*type,
DIR == Direction::Input
? common::DefinedIo::ReadUnformatted
: common::DefinedIo::WriteUnformatted)}) {
if (definedIo->subroutine) {
typeInfo::SpecialBinding special{DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted,
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
false};
if (DefinedUnformattedIo(io_, instance_, *type, special)) {
anyIoTookPlace_ = true;
return StatOk;
}
} else {
int status{workQueue.BeginDerivedIo<DIR>(
io_, instance_, *type, table_, anyIoTookPlace_)};
return status == StatContinue ? StatOk : status; // done here
}
} else {
int status{workQueue.BeginDerivedIo<DIR>(
io_, instance_, *type, table_, anyIoTookPlace_)};
return status == StatContinue ? StatOk : status; // done here
}
}
}
if (const typeInfo::SpecialBinding *special{
type->FindSpecialBinding(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
if (!table_ || !table_->ignoreNonTbpEntries || special->IsTypeBound()) {
// defined derived type unformatted I/O
if (DefinedUnformattedIo(io_, instance_, *type, *special)) {
anyIoTookPlace_ = true;
return StatOk;
} else {
return IostatEnd;
if (const typeInfo::SpecialBinding *special{
type->FindSpecialBinding(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
if (!table_ || !table_->ignoreNonTbpEntries ||
special->IsTypeBound()) {
// defined derived type unformatted I/O
if (DefinedUnformattedIo(io_, instance_, *type, *special)) {
anyIoTookPlace_ = true;
return StatOk;
} else {
return IostatEnd;
}
}
}
}

7
flang/docs/Extensions.md
View File

@@ -868,6 +868,13 @@ print *, [(j,j=1,10)]
the elements for each component before proceeding to the next component.
A program using defined assignment might be able to detect the difference.
* The standard forbids instances of derived types with defined unformatted
WRITE subroutines from appearing in the I/O list of an `INQUIRE(IOLENGTH=...)`
statement. It then also says that these defined I/O procedures should be
ignored for that statement. So we allow them to appear (like most
compilers) and don't use any defined unformatted WRITE that might have been
defined.
## De Facto Standard Features
* `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the