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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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.

>From 5532f165ed02072f3b3092dd2f829798a1a7ab9e Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 16 Jun 2025 16:35:33 -0700
Subject: [PATCH] [flang][runtime] Allow INQUIRE(IOLENGTH=) in the presence of
 defined I/O

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.
---
 flang-rt/lib/runtime/descriptor-io.cpp | 63 ++++++++++++++------------
 flang/docs/Extensions.md               |  7 +++
 2 files changed, 40 insertions(+), 30 deletions(-)

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