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

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

View File

@@ -451,6 +451,7 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
if (const typeInfo::DerivedType *type{
addendum ? addendum->derivedType() : nullptr}) {
// derived type unformatted I/O
if (DIR == Direction::Input || !io_.get_if<InquireIOLengthState>()) {
if (table_) {
if (const auto *definedIo{table_->Find(*type,
DIR == Direction::Input
@@ -477,7 +478,8 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
type->FindSpecialBinding(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
if (!table_ || !table_->ignoreNonTbpEntries || special->IsTypeBound()) {
if (!table_ || !table_->ignoreNonTbpEntries ||
special->IsTypeBound()) {
// defined derived type unformatted I/O
if (DefinedUnformattedIo(io_, instance_, *type, *special)) {
anyIoTookPlace_ = true;
@@ -487,6 +489,7 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
}
}
}
}
// Default derived type unformatted I/O
// TODO: If no component at any level has defined READ or WRITE
// (as appropriate), the elements are contiguous, and no byte swapping

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