re PR fortran/78881 ([F03] reading from string with DTIO procedure does not work properly)

2017-03-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/78881
	* io/io.h (st_parameter_dt): Rename unused component last_char to
	child_saved_iostat. Move comment to gfc_unit.
	* io/list_read.c (list_formatted_read_scalar): After call to
	child READ procedure, save the returned iostat value for later
	check. (finish_list_read): Only finish READ if child_saved_iostat
	was OK.
	* io/transfer.c (read_sf_internal): If there is a saved character
	in last character, seek back one. Add a new check for EOR
	condition. (read_sf): If there is a saved character
	in last character, seek back one. (formatted_transfer_scalar_read):
	Initialize last character before invoking child procedure.
	(data_transfer_init): If child dtio, set advance
	status to nonadvancing. Move update of size and check for EOR
	condition to before child dtio return.

	* gfortran.dg/dtio_26.f90: New test.

From-SVN: r246478

2 files changed, 74 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8306a1c..005cbe4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-03-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/78881
+	* gfortran.dg/dtio_26.f90: New test.
+
 2017-03-25  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/80156
diff --git a/gcc/testsuite/gfortran.dg/dtio_26.f03 b/gcc/testsuite/gfortran.dg/dtio_26.f03
new file mode 100644
index 0000000..e947545
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_26.f03
@@ -0,0 +1,69 @@
+! { dg-do run }
+! PR78881 test for correct end of record condition and ignoring advance=
+module t_m
+   use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
+   implicit none
+   type, public :: t
+      character(len=:), allocatable :: m_s
+   contains
+      procedure, pass(this) :: read_t
+      generic :: read(formatted) => read_t
+   end type t
+contains
+subroutine read_t(this, lun, iotype, vlist, istat, imsg)
+  class(t), intent(inout)         :: this
+  integer, intent(in)             :: lun
+  character(len=*), intent(in)    :: iotype
+  integer, intent(in)             :: vlist(:)
+  integer, intent(out)            :: istat
+  character(len=*), intent(inout) :: imsg
+  character(len=1) :: c
+  integer :: i
+  i = 0 ; imsg=''
+  loop_read: do
+    i = i + 1
+    read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
+    select case ( istat )
+    case ( 0 )
+      if (i.eq.1 .and. c.ne.'h') exit loop_read
+      !write( output_unit, fmt=sfmt) "i = ", i, ", c = ", c
+    case ( iostat_end )
+      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_end"
+      exit loop_read
+    case ( iostat_eor )
+      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_eor"
+      exit loop_read
+    case default
+      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = ", istat
+      exit loop_read
+    end select
+    if (i.gt.10) exit loop_read
+  end do loop_read
+end subroutine read_t
+end module t_m
+
+program p
+  use t_m, only : t
+  implicit none
+  
+  character(len=:), allocatable :: s
+  type(t) :: foo
+  character(len=256) :: imsg
+  integer :: istat
+  
+  open(10, status="scratch")
+  write(10,'(a)') 'hello'
+  rewind(10)
+  read(unit=10, fmt='(dt)', iostat=istat, iomsg=imsg) foo
+  if (imsg.ne."End of record") call abort
+  rewind(10)
+  read(unit=10, fmt=*, iostat=istat, iomsg=imsg) foo
+  if (imsg.ne."End of record") call abort
+  s = "hello"
+  read( unit=s, fmt='(dt)', iostat=istat, iomsg=imsg) foo
+  if (imsg.ne."End of record") call abort
+  read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo
+  if (imsg.ne."End of record") call abort
+end program p
+
+! { dg-final { cleanup-modules "t_m" } }