From 3aeb697a2158d359d9f951f6c6c6bcd9c53c8c2f Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Wed, 24 Jul 2024 10:29:08 -0700
Subject: [PATCH] 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.
---
gcc/testsuite/gfortran.dg/pr105361.f90 | 41 ++++++++++++++++++++++++++
libgfortran/io/list_read.c | 3 +-
2 files changed, 43 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr105361.f90
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)
--
GitLab