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{ if (const typeInfo::DerivedType *type{
addendum ? addendum->derivedType() : nullptr}) { addendum ? addendum->derivedType() : nullptr}) {
// derived type unformatted I/O // derived type unformatted I/O
if (table_) { if (DIR == Direction::Input || !io_.get_if<InquireIOLengthState>()) {
if (const auto *definedIo{table_->Find(*type, if (table_) {
DIR == Direction::Input if (const auto *definedIo{table_->Find(*type,
? common::DefinedIo::ReadUnformatted DIR == Direction::Input
: common::DefinedIo::WriteUnformatted)}) { ? common::DefinedIo::ReadUnformatted
if (definedIo->subroutine) { : common::DefinedIo::WriteUnformatted)}) {
typeInfo::SpecialBinding special{DIR == Direction::Input if (definedIo->subroutine) {
? typeInfo::SpecialBinding::Which::ReadUnformatted typeInfo::SpecialBinding special{DIR == Direction::Input
: typeInfo::SpecialBinding::Which::WriteUnformatted, ? typeInfo::SpecialBinding::Which::ReadUnformatted
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, : typeInfo::SpecialBinding::Which::WriteUnformatted,
false}; definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
if (DefinedUnformattedIo(io_, instance_, *type, special)) { false};
anyIoTookPlace_ = true; if (DefinedUnformattedIo(io_, instance_, *type, special)) {
return StatOk; 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{
if (const typeInfo::SpecialBinding *special{ type->FindSpecialBinding(DIR == Direction::Input
type->FindSpecialBinding(DIR == Direction::Input ? typeInfo::SpecialBinding::Which::ReadUnformatted
? typeInfo::SpecialBinding::Which::ReadUnformatted : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
: typeInfo::SpecialBinding::Which::WriteUnformatted)}) { if (!table_ || !table_->ignoreNonTbpEntries ||
if (!table_ || !table_->ignoreNonTbpEntries || special->IsTypeBound()) { special->IsTypeBound()) {
// defined derived type unformatted I/O // defined derived type unformatted I/O
if (DefinedUnformattedIo(io_, instance_, *type, *special)) { if (DefinedUnformattedIo(io_, instance_, *type, *special)) {
anyIoTookPlace_ = true; anyIoTookPlace_ = true;
return StatOk; return StatOk;
} else { } else {
return IostatEnd; 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. the elements for each component before proceeding to the next component.
A program using defined assignment might be able to detect the difference. 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 ## De Facto Standard Features
* `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the