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
This commit is contained in:
Jerry DeLisle 2017-05-29 19:17:57 +00:00
parent a5cfa13ab9
commit fd262197d7
4 changed files with 37 additions and 0 deletions

View File

@ -1,3 +1,8 @@
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)

View File

@ -0,0 +1,21 @@
! { 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

View File

@ -1,3 +1,9 @@
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

View File

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