re PR fortran/53029 (missed optimization in internal read (without implied-do-loop))

2017-05-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/53029
	* list_read.c (list_formatted_read_scala): Set the err return
	value to the common.flags error values.

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

From-SVN: r248577

gcc/testsuite/ChangeLog

+2017-05-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/53029
+	* gfortran.dg/read_5.f90: New test.
+
 2017-05-29  Nathan Sidwell  <nathan@acm.org>
 
 	PR c++/80891 (#4)

gcc/testsuite/gfortran.dg/read_5.f90

+! { dg-do run }
+! PR53029 Missed optimization, this test case took several seconds to
+      program internalread
+      implicit none
+      integer m
+      parameter(m=1000000)
+      character value*10
+      character(80) :: result
+      integer i,j,intvalues(m)
+      real :: start, finish
+      intvalues = 33
+      call cpu_time(start)
+      do j=1,100
+        write(value,'(i3,a5)') j," 5 69"
+        read(value,*,end=20) intvalues
+   20   write(result,*) (intvalues(i),i=2,4)
+      if (result.ne.('           5          69          33')) call abort
+      call cpu_time(finish)
+      if ((finish-start).gt. 0.5) call abort
+      enddo
+      end program internalread

libgfortran/ChangeLog

+2017-05-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/53029
+	* list_read.c (list_formatted_read_scala): Set the err return
+	value to the common.flags error values.
+
 2017-05-28  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	* acinclude.m4 (LIBGFOR_CHECK_FMA3): Use test from

libgfortran/io/list_read.c

@@ -2298,11 +2298,16 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
     free_saved (dtp);
 
 cleanup:
+  /* err may have been set above from finish_separator, so if it is set
+     trigger the hit_eof. The hit_eof will set bits in common.flags.  */
   if (err == LIBERROR_END)
     {
       free_line (dtp);
       hit_eof (dtp);
     }
+  /* Now we check common.flags for any errors that could have occurred in
+     a READ elsewhere such as in read_integer.  */
+  err = dtp->common.flags & IOPARM_LIBRETURN_MASK;
   fbuf_flush_list (dtp->u.p.current_unit, LIST_READING);
   return err;
 }