OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix EOF handling for arrays. 

2019-11-23  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Harald Anlauf <anlauf@gmx.de>

	PR fortran/92569
	* io/transfer.c (transfer_array_inner):  If position is
	at AFTER_ENDFILE in current unit, return from data loop.

2019-11-23  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Harald Anlauf <anlauf@gmx.de>

	PR fortran/92569
	* gfortran.dg/eof_6.f90: New test.


Co-Authored-By: Harald Anlauf <anlauf@gmx.de>

From-SVN: r278659
This commit is contained in:
Thomas Koenig 2019-11-24 19:16:23 +00:00
parent af4e8d4d5a
commit 859174c824
4 changed files with 87 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2019-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
Harald Anlauf <anlauf@gmx.de>
PR fortran/92569
* gfortran.dg/eof_6.f90: New test.
2019-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92422

23
gcc/testsuite/gfortran.dg/eof_6.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
! { dg-options "-ffrontend-optimize" }
! PR 92569 - the EOF condition was not recognized with
! -ffrontend-optimize. Originjal test case by Bill Lipa.
program main
implicit none
real(kind=8) :: tdat(1000,10)
real(kind=8) :: res (10, 3)
integer :: i, j, k, np
open (unit=20, status="scratch")
res = reshape([(real(i),i=1,30)], shape(res))
write (20,'(10G12.5)') res
rewind 20
do j = 1,1000
read (20,*,end=1)(tdat(j,k),k=1,10)
end do
1 continue
np = j-1
if (np /= 3) stop 1
if (any(transpose(res) /= tdat(1:np,:))) stop 2
end program main

7
libgfortran/ChangeLog
View File

@ -1,3 +1,10 @@
2019-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
Harald Anlauf <anlauf@gmx.de>
PR fortran/92569
* io/transfer.c (transfer_array_inner): If position is
at AFTER_ENDFILE in current unit, return from data loop.
2019-11-18 Maciej W. Rozycki <macro@wdc.com>
* Makefile.in: Regenerate.

66
libgfortran/io/transfer.c
View File

@ -2542,26 +2542,62 @@ transfer_array_inner (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
data = GFC_DESCRIPTOR_DATA (desc);
while (data)
/* When reading, we need to check endfile conditions so we do not miss
an END=label. Make this separate so we do not have an extra test
in a tight loop when it is not needed. */
if (dtp->u.p.current_unit && dtp->u.p.mode == READING)
{
dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize);
data += stride0 * tsize;
count[0] += tsize;
n = 0;
while (count[n] == extent[n])
while (data)
{
count[n] = 0;
data -= stride[n] * extent[n];
n++;
if (n == rank)
if (unlikely (dtp->u.p.current_unit->endfile == AFTER_ENDFILE))
return;
dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize);
data += stride0 * tsize;
count[0] += tsize;
n = 0;
while (count[n] == extent[n])
{
data = NULL;
break;
count[n] = 0;
data -= stride[n] * extent[n];
n++;
if (n == rank)
{
data = NULL;
break;
}
else
{
count[n]++;
data += stride[n];
}
}
else
}
}
else
{
while (data)
{
dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize);
data += stride0 * tsize;
count[0] += tsize;
n = 0;
while (count[n] == extent[n])
{
count[n]++;
data += stride[n];
count[n] = 0;
data -= stride[n] * extent[n];
n++;
if (n == rank)
{
data = NULL;
break;
}
else
{
count[n]++;
data += stride[n];
}
}
}
}