https://gcc.gnu.org/g:3aeb697a2158d359d9f951f6c6c6bcd9c53c8c2f
commit r15-2320-g3aeb697a2158d359d9f951f6c6c6bcd9c53c8c2f
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Wed Jul 24 10:29:08 2024 -0700
Fortran: Suppress wrong End Of File error with user defined IO.
PR libfortran/105361
libgfortran/ChangeLog:
* io/list_read.c (finish_list_read): Add a condition check for
a user defined derived type IO operation to avoid calling the
EOF error.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr105361.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/pr105361.f90 | 41 ++++++++++++++++++++++++++++++++++
libgfortran/io/list_read.c | 3 ++-
2 files changed, 43 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gfortran.dg/pr105361.f90
b/gcc/testsuite/gfortran.dg/pr105361.f90
new file mode 100644
index 000000000000..e2d3b07cacaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105361.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+
+module x
+ implicit none
+ type foo
+ real :: r
+ end type foo
+ interface read(formatted)
+ module procedure read_formatted
+ end interface read(formatted)
+contains
+ subroutine read_formatted (dtv, unit, iotype, vlist, iostat, iomsg)
+ class (foo), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character (len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character (len=*), intent(inout) :: iomsg
+ read (unit,*,iostat=iostat,iomsg=iomsg) dtv%r
+ !print *,dtv%r
+ end subroutine read_formatted
+end module x
+
+program main
+ use x
+ implicit none
+ type(foo) :: a, b
+ real :: c, d
+ open(10, access="stream")
+ write(10) "1 2" ! // NEW_LINE('A')
+ close(10)
+ open(10)
+ read(10,*) c, d
+ if ((c /= 1.0) .or. (d /= 2.0)) stop 1
+ rewind(10)
+ !print *, c,d
+ read (10,*) a, b
+ close(10, status="delete")
+ if ((a%r /= 1.0) .or. (b%r /= 2.0)) stop 2
+ !print *, a,b
+end program main
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 5bbbef26c267..96b2efe854f5 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2431,7 +2431,8 @@ finish_list_read (st_parameter_dt *dtp)
/* Set the next_char and push_char worker functions. */
set_workers (dtp);
- if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK))
+ if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK)
+ && ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0))
{
c = next_char (dtp);
if (c == EOF)
