[flang-commits] [flang] deb2861 - [flang] Allow for equivalent types in non-TBP defined I/O (#158755)

[via flang-commits]

Author: Peter Klausler
Date: 2025-09-17T09:15:57-07:00
New Revision: deb2861b07e503b729b854edbffdeae7cd4a1aa6

URL: https://github.com/llvm/llvm-project/commit/deb2861b07e503b729b854edbffdeae7cd4a1aa6
DIFF: https://github.com/llvm/llvm-project/commit/deb2861b07e503b729b854edbffdeae7cd4a1aa6.diff

LOG: [flang] Allow for equivalent types in non-TBP defined I/O (#158755)

Non-extensible derived type -- those with SEQUENCE or BIND(C) -- are
allowed as monomorphic "dtv" dummy arguments to defined I/O subroutines.
Fortran's type rules admit structural equivalence for these types, and
it's possible that I/O might be attempted in a scope using a
non-extensible type that's equivalent to a non-type-bound generic
interface's specific procedure's "dtv" dummy argument's type, but not
defined in the same place.

Fixes https://github.com/llvm/llvm-project/issues/158673.

This is an IBM Fortran test case that doesn't need to be duplicated in
LLVM.

Added: 
    

Modified: 
    flang/lib/Semantics/runtime-type-info.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index b8c3db8723964..bbaded36c62e3 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -1385,12 +1385,31 @@ CollectNonTbpDefinedIoGenericInterfaces(
           if (const DeclTypeSpec *
               declType{GetDefinedIoSpecificArgType(*specific)}) {
             const DerivedTypeSpec &derived{DEREF(declType->AsDerived())};
-            if (const Symbol *
-                dtDesc{derived.scope()
-                        ? derived.scope()->runtimeDerivedTypeDescription()
+            const Scope *derivedScope{derived.scope()};
+            if (!declType->IsPolymorphic()) {
+              // A defined I/O subroutine with a monomorphic "dtv" dummy
+              // argument implies a non-extensible sequence or BIND(C) derived
+              // type.  Such types may be defined more than once in the program
+              // so long as they are structurally equivalent.  If the current
+              // scope has an equivalent type, use it for the table rather
+              // than the "dtv" argument's type.
+              if (const Symbol *inScope{scope.FindSymbol(derived.name())}) {
+                const Symbol &ultimate{inScope->GetUltimate()};
+                DerivedTypeSpec localDerivedType{inScope->name(), ultimate};
+                if (ultimate.has<DerivedTypeDetails>() &&
+                    evaluate::DynamicType{derived, /*isPolymorphic=*/false}
+                        .IsTkCompatibleWith(evaluate::DynamicType{
+                            localDerivedType, /*iP=*/false})) {
+                  derivedScope = ultimate.scope();
+                }
+              }
+            }
+            if (const Symbol *dtDesc{derivedScope
+                        ? derivedScope->runtimeDerivedTypeDescription()
                         : nullptr}) {
               if (useRuntimeTypeInfoEntries &&
-                  &derived.scope()->parent() == &generic->owner()) {
+                  derivedScope == derived.scope() &&
+                  &derivedScope->parent() == &generic->owner()) {
                 // This non-TBP defined I/O generic was defined in the
                 // same scope as the derived type, and it will be
                 // included in the derived type's special bindings
@@ -1454,7 +1473,8 @@ static const Symbol *FindSpecificDefinedIo(const Scope &scope,
       const Symbol &specific{*ref};
       if (const DeclTypeSpec *
           thisType{GetDefinedIoSpecificArgType(specific)}) {
-        if (evaluate::DynamicType{DEREF(thisType->AsDerived()), true}
+        if (evaluate::DynamicType{
+                DEREF(thisType->AsDerived()), thisType->IsPolymorphic()}
                 .IsTkCompatibleWith(derived)) {
           return &specific.GetUltimate();
         }