[flang-commits] [flang] dccc026 - [flang][runtime] Allow INQUIRE(IOLENGTH=) in the presence of defined I/O (#144541)
via flang-commits
flang-commits at lists.llvm.org
Mon Jun 30 10:20:42 PDT 2025
Author: Peter Klausler
Date: 2025-06-30T10:20:39-07:00
New Revision: dccc0266f423b60e6fc61ecdbac0cc91a99d28ed
URL: https://github.com/llvm/llvm-project/commit/dccc0266f423b60e6fc61ecdbac0cc91a99d28ed
DIFF: https://github.com/llvm/llvm-project/commit/dccc0266f423b60e6fc61ecdbac0cc91a99d28ed.diff
LOG: [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.
Added:
Modified:
flang-rt/lib/runtime/descriptor-io.cpp
flang/docs/Extensions.md
Removed:
################################################################################
diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp
index e7b99e6fc3a2b..b208cb2c397b3 100644
--- a/flang-rt/lib/runtime/descriptor-io.cpp
+++ b/flang-rt/lib/runtime/descriptor-io.cpp
@@ -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;
+ }
}
}
}
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 871749934810c..3503a0dde694b 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -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
diff erence.
+* 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
More information about the flang-commits
mailing list