[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.
This commit is contained in:
Peter Klausler
2025-09-17 09:15:57 -07:00
committed by GitHub
parent 8fb02fae99
commit deb2861b07

View File

@@ -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();
}