mirror of
https://github.com/gcc-mirror/gcc.git
synced 2024-11-21 13:40:47 +00:00
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:
parent
a86c0cb937
commit
3aeb697a21
41
gcc/testsuite/gfortran.dg/pr105361.f90
Normal file
41
gcc/testsuite/gfortran.dg/pr105361.f90
Normal 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
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user