From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Mon, 25 Nov 2019 20:04:28 +0000 (+0000)
Subject: Fix EOF handling for arrays.
X-Git-Tag: releases/gcc-9.3.0~355
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f61f7b69491548dd438b3dcc895a3a528f560bfd;p=thirdparty%2Fgcc.git

Fix EOF handling for arrays.

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

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

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

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


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

From-SVN: r278702
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 40c60b99e907..c07ef85ce927 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-11-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	Harald Anlauf <anlauf@gmx.de>
+
+	Backport from trunk
+	PR fortran/92569
+	* gfortran.dg/eof_6.f90: New test.
+
 2019-11-25  Tobias Burnus  <tobias@codesourcery.com
 
 	Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/eof_6.f90 b/gcc/testsuite/gfortran.dg/eof_6.f90
new file mode 100644
index 000000000000..1c155576b77e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eof_6.f90
@@ -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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6dc32e8e1733..5bf3cc8340d2 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	Harald Anlauf <anlauf@gmx.de>
+
+	Backport from trunk
+	PR fortran/92569
+	* io/transfer.c (transfer_array_inner):  If position is
+	at AFTER_ENDFILE in current unit, return from data loop.
+
 2019-11-13  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index c43360f6332b..8ed0391225d1 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2529,26 +2529,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];
+		}
 	    }
 	}
     }