Fix EOF handling for arrays.
authorThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 24 Nov 2019 19:16:23 +0000 (19:16 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 24 Nov 2019 19:16:23 +0000 (19:16 +0000)
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

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/eof_6.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/io/transfer.c

index 2135c2f2be279b93e64dbd2bd692300c04cd1762..9ff8a951623ed3bfc69f225708e3c56d529bcf2e 100644 (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
diff --git a/gcc/testsuite/gfortran.dg/eof_6.f90 b/gcc/testsuite/gfortran.dg/eof_6.f90
new file mode 100644 (file)
index 0000000..1c15557
--- /dev/null
@@ -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
index 3b838a4a95ea40452052be4ae06448126909b47e..46b96f25f1699e42e86cc9f95947f82966cde514 100644 (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.
index 6382d0dad0909d398bd8ee78066f2ee5a23a8099..89f0abe9938920b385a8f5c03cfaa70b3938f467 100644 (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];
+               }
            }
        }
     }