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 --git a/gcc/testsuite/gfortran.dg/pr105361.f90 b/gcc/testsuite/gfortran.dg/pr105361.f90
new file mode 100644 (file)
index 0000000..e2d3b07
--- /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 5bbbef26c2675964381af617352dc89362258aa3..96b2efe854f5b340911a87e4614deffa293daa06 100644 (file)
--- 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)