[flang] Silence bogus error message

[klausler]

Fortran doesn't permit the use of a polymorphic I/O list item for intrinsic data transfers, so the compiler emits an error message for polymorphic items whose types can't possibly be handled by a defined I/O subroutine. This check didn't allow for the possibility that the defined I/O subroutine might apply to the parent component of an extended type.

Fixes #111021.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Fortran doesn't permit the use of a polymorphic I/O list item for intrinsic data transfers, so the compiler emits an error message for polymorphic items whose types can't possibly be handled by a defined I/O subroutine. This check didn't allow for the possibility that the defined I/O subroutine might apply to the parent component of an extended type.

Fixes #111021.

---

Full diff: https://github.com/llvm/llvm-project/pull/111057.diff

2 Files Affected:

• (modified) flang/lib/Semantics/tools.cpp (+4-1)
• (modified) flang/test/Semantics/io14.f90 (+5-6)

diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 3723b28fecef52..714417850cefa5 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1649,7 +1649,10 @@ bool HasDefinedIo(common::DefinedIo which, const DerivedTypeSpec &derived,
       }
     }
   }
-  return false;
+  // Check for inherited defined I/O
+  const auto *parentType{derived.typeSymbol().GetParentTypeSpec()};
+  return parentType && HasDefinedIo(which, *parentType, scope);
+  ;
 }
 
 void WarnOnDeferredLengthCharacterScalar(SemanticsContext &context,
diff --git a/flang/test/Semantics/io14.f90 b/flang/test/Semantics/io14.f90
index 6dd6763bc944b9..39f91f5bd2752b 100644
--- a/flang/test/Semantics/io14.f90
+++ b/flang/test/Semantics/io14.f90
@@ -9,6 +9,8 @@ module m
     procedure :: fwrite
     generic :: write(formatted) => fwrite
   end type
+  type, extends(t) :: t2
+  end type
  contains
   subroutine fwrite(x, unit, iotype, vlist, iostat, iomsg)
     class(t), intent(in) :: x
@@ -19,19 +21,16 @@ subroutine fwrite(x, unit, iotype, vlist, iostat, iomsg)
     character(*), intent(in out) :: iomsg
     write(unit, *, iostat=iostat, iomsg=iomsg) '(', iotype, ':', vlist, ':', x%n, ')'
   end subroutine
-  subroutine subr(x, y, z)
+  subroutine subr(x, y, z, w)
     class(t), intent(in) :: x
     class(base), intent(in) :: y
     class(*), intent(in) :: z
+    class(t2), intent(in) :: w
     print *, x ! ok
+    print *, w ! ok
     !ERROR: Derived type 'base' in I/O may not be polymorphic unless using defined I/O
     print *, y
     !ERROR: I/O list item may not be unlimited polymorphic
     print *, z
   end subroutine
 end
-
-program main
-  use m
-  call subr(t(123),t(234),t(345))
-end

[kkwli]

LG

Thanks for the quick fix.

[kkwli]

I think this statement is not necessary.