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.
This commit is contained in:
Jerry DeLisle 2024-07-24 10:29:08 -07:00
parent a86c0cb937
commit 3aeb697a21
2 changed files with 43 additions and 1 deletions

View File

@ -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

View File

@ -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)