gcc/testsuite/gfortran.dg/dtio_26.f03

   1 ! { dg-do run }
   2 ! PR78881 test for correct end of record condition and ignoring advance=
   3 module t_m
   4    use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
   5    implicit none
   6    type, public :: t
   7       character(len=:), allocatable :: m_s
   8    contains
   9       procedure, pass(this) :: read_t
  10       generic :: read(formatted) => read_t
  11    end type t
  12 contains
  13 subroutine read_t(this, lun, iotype, vlist, istat, imsg)
  14   class(t), intent(inout)         :: this
  15   integer, intent(in)             :: lun
  16   character(len=*), intent(in)    :: iotype
  17   integer, intent(in)             :: vlist(:)
  18   integer, intent(out)            :: istat
  19   character(len=*), intent(inout) :: imsg
  20   character(len=1) :: c
  21   integer :: i
  22   i = 0 ; imsg=''
  23   loop_read: do
  24     i = i + 1
  25     read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
  26     select case ( istat )
  27     case ( 0 )
  28       if (i.eq.1 .and. c.ne.'h') exit loop_read
  29       !write( output_unit, fmt=sfmt) "i = ", i, ", c = ", c
  30     case ( iostat_end )
  31       !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_end"
  32       exit loop_read
  33     case ( iostat_eor )
  34       !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_eor"
  35       exit loop_read
  36     case default
  37       !write( output_unit, fmt=sfmt) "i = ", i, ", istat = ", istat
  38       exit loop_read
  39     end select
  40     if (i.gt.10) exit loop_read
  41   end do loop_read
  42 end subroutine read_t
  43 end module t_m
  44
  45 program p
  46   use t_m, only : t
  47   implicit none
  48
  49   character(len=:), allocatable :: s
  50   type(t) :: foo
  51   character(len=256) :: imsg
  52   integer :: istat
  53
  54   open(10, status="scratch")
  55   write(10,'(a)') 'hello'
  56   rewind(10)
  57   read(unit=10, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  58   if (imsg.ne."End of record") STOP 1
  59   rewind(10)
  60   read(unit=10, fmt=*, iostat=istat, iomsg=imsg) foo
  61   if (imsg.ne."End of record") STOP 2
  62   s = "hello"
  63   read( unit=s, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  64   if (imsg.ne."End of record") STOP 3
  65   read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo
  66   if (imsg.ne."End of record") STOP 4
  67 end program p